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Abstract 


The DMSP F-7 satellite was an operational Air Force meteorological 
satellite which carried a magnetometer for geophysical measurements. The 
magnetometer was located within the body of the spacecraft in the presence 
of large spacecraft fields. In addition to stray magnetic fields, the data 
have inherent position and time inaccuracies. Algorithms were developed to 
identify and remove time varying magnetic field noise from the data. These 
algorithms are embodied in an automated procedure which fits a smooth curve 
through the data and then identifies outliers and which filters the 
predominant fourier components of noise from the data. Techniques 
developed for Magsat were then modified and used to attempt determination 
of the spacecraft fields, of any rotation between the magnetometer axes and 
the spacecraft axes, and of any scale changes within the magnetometer 
itself. Software setup and usage are documented and program listings are 
included in the Appendix. The initial and resulting data are archived on 
magnetic cartridge and the formats documented. 
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I. Introduction 


The DMSP F7 spacecraft was launched on 18 Nov, 1983 into a 98.74 degree 
inclination orbit, with apogee 844 km altitude and perigee 822 km. (Rich, 
1984). The primary purpose of the spacecraft was to obtain tropospheric 
meteorological data. However, a triaxial fluxgate magnetometer was included 
on the spacecraft in order to monitor the geophysical environment. This 
report is the second of two dealing with the examination of these 
magnetometer data to evaluate their usefulness in describing the earth s 
core-produced geomagnetic field. The first report "Processing of DMSP 
Magnetic Data and its Use in Geomagnetic Field Modeling" (Ridgway et. al, 
1989), henceforth referred to as paper 1, gave an overall summary of the 
processing methods and results and of the field modeling efforts. Some of 
the material in that report is duplicated in the present document. However 
the emphasis in this document is to describe the software utilized, the 
crucial data sets and the processing procedures. All pertinent data sets, 
code, JCL , etc. are stored on magnetic cartridge, as documented herin. 

The DMSP F7 magnetometer was mounted on the satellite body, as opposed 
to being attached to a boom, because of spacecraft engineering constraints 
(Rich, 1984). The magnetometer, a triaxial fluxgate, was aligned with the 
spacecraft X, Y and Z axes, which are defined as follows: X is vertically 

down, Y is along-track and Z is cross-track. The three sensor units were 
built by the Schonstedt Instrument Co., Reston, VA, in the 1960 s . The 
electronics unit for the magnetometer was built by the Applied Physics 
Laboratory of Johns Hopkins University, Laurel, MD, based on the design of 
the MAGSAT fluxgate magnetometer. 

The magnetometer acquired field measurements at a rate of 20 samples 
per second. Measurements were in the form of counts, with one count 
equalling 12 nano-Teslas (nT) . According to Rich (1984), the instrument was 
not intended to survey the main geomagnetic field, so it was not calibrated 
with high accuracy on the ground, nor recalibrated in orbit. 


Because of the close proximity of the magnetometer to on-board 
electronic instrumentation, its data were contaminated by non- random 
instrumental noise, with magnitudes of up to several thousand nT. The 
attitude of the spacecraft was measured to an accuracy of about 0.1 degree, 
or 360 arc-seconds. While this attitude accuracy is not as good as that 
obtained with MAGSAT, in principle it is of sufficient accuracy to enable 
meaningful vector measurements . In the absence of other near-Earth 
satellite magnetic field data for this time period, and in view of the 
success of methods used on MAGSAT to solve for spacecraft fields, it was 
decided to investigate the possibility of processing the DMSP F7 data to a 
stage where they may be useful for main field modeling. 


II. Transformation of On-tape Data to Magnetic Readings. 


The magnetometer data contained on the basic DMSP data tapes received 
from the Air Force is in the form of magnetometer counts, which must be 
converted into field values in nT in order to be useful. Data is arranged 
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on the tape as a header, containing time and position information for each 
minute of operation, followed by 60 magnetometer readings (1 per second). 

See description of tape format in Section VII. All times on the data are 
rounded to the nearest second. All positions on the original Air Force data 
are expressed in nautical miles, rounded down to the nearest nautical mile. 
Nautical miles were converted to kilometers (one nautical mile equals about 
1.8 km) in subsequent data processing. 

20 readings per second for each of the magnetometer X, Y and Z axes 
were originally recorded by DMSP, although only readings #1 and /II were 
written on the tapes sent to the Geology and Geomagnetism branch at Goddard. 
For the Goddard main field studies, only the magnetometer reading associated 
with the header record was utilized. This preserved sufficient data density 
(one reading per minute) to fully describe the main geomagnetic field. 

The magnetometer was calibrated prior to launch at the NASA Goddard 
Space Flight Center magnetic test chamber with the following results (Rich, 
1984) : 


1) Measurement = Calibration Matrix * Measurement + Bias 
(nT) (nT/count) (counts) (nT) 
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This equation is used to compute the magnetic field in spacecraft 
coordinates in nT, given a reading in magnetometer counts. However, this 
calibration does not take into account the field from the spacecraft, which 
adds greatly to the bias vector. This vector must be determined from in- 
flight data. Later work using the FIT program (see Field Value corrections) 
accomplished this, and re-determined the bias vector as: (89nT, 8457nT, 
-1441nT) for radial, along-track and cross-track measurements, respectively. 
These values are still somewhat approximate and require small corrections 
discussed in paper 1. In addition, for computational ease, it was decided to 
redefine the spacecraft system to be compatible with the MAGSAT coordinate 
system, so that the spacecraft X axis is defined as cross-track, Y is 
radially down and Z is along-track. The correct transformation of DMSP 
magnetometer counts to nano-teslas in spacecraft coordinates compatible with 
MAGSAT is thus: 
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2) Measurement = Calibration Matrix * Measurement + 
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All data discussed in the remainder of this report are assumed to have been 
processed through this equation and have units of nT. The (B x ,By,B z ) 
measurement vector in equation #2 will henceforth have the label Bspu, 
meaning the vector is in MAGSAT spacecraft coordinates and not yet processed 
through the final corrections. 


III. Field Value Corrections. 

According to Rich (1984), the DMSP magnetometer may be misaligned 
relative to the spacecraft by as much as 0.5 degree per axis, with the 
misalignment measured to an accuracy of about 0.1 degree. Also, bending of 
the spacecraft body may result in further misalignment. In addition, the 
values of the three magnetic components may be in error by a fixed bias or 
by a multiplying factor. The FIT program has the capability to solve for 
corrections in these parameters in conjunction with the least squares main 
field solution. The theory of this adjustment is as follows (see also 
Estes , 1983 ) : 

The FIT program computes three types of adjustments to vector 
satellite magnetometer data: 1) A diagonal calibration matrix containing 

"slope" parameters, which is multiplied times the measured vector to correct 
for magnetometer drift, 2) a bias correction vector which is subtracted from 
the measured vector to correct for constant magnitude offsets, and 3) a 
rotation matrix which is multiplied times the measured vector to correct for 
angular offsets of the magnetometer from ideal satellite coordinates. These 
adjustment parameters are applied to the measured uncorrected data in 
spacecraft coordinates according to the equation: 

3) Bspc = TSM * TCAL * (Bspu - bias) 

where: Bspu is the uncorrected measurement vector in spacecraft 
coordinates, as given in equation 2). 

Bspc is the corrected measurement vector in spacecraft 
coordinates. 

bias is a vector of magnetometer bias corrections in addition 
to those given in equation 2) . 

TCAL is the calibration correction matrix of slope parameters. 

TSM is the rotation correction matrix. 
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The elements of bias are: (BS^, BS2, BS3), where BSi are component 

biases derived in the FIT program, with values derived and discussed in 
paper 1. 

TCAL has elements: fl/SLi 0 0 1 

I I 

I 0 1 /SL 2 0 I 

I I 

l 0 0 I/SL3J 

where SLi are slopes derived in the FIT program, SLi and BS^ are 
applied to the satellite X axis, SL2 and BS2 to satellite Y axis, and SL3 
and BS3 to the satellite Z axis components. 

The elements of TSH are based on three Euler angles ( £ x ,£y, and £ z ) 
solved in execution of the FIT program. ( Note : In the FIT program, as of 
2 / 28 / 88 , £ x is denoted £2* e y is denoted £1, and £ z is denoted £3.) Using 
the notation TSMij , where i is the matrix row and j the matrix column, these 
are : 

4 ) TSMn = COS€y*COS£ z 

TSM12 = cos£y*cose x *sin£ z + sin£y*sin€ x 

TSM13 = -cos£y*sin£ x *sin£ z + sin£y*cos€ x 

TSM21 = -sine z 

TSM22 = cos£ x *cos£ z 

TSM23 = -sin£ x *cos€ z 

TSM31 = -sin£y*cos£ z 

TSM32 = cos£y*sin£ x - sin£y*sin£ z *cose x 

TSM33 = cos£y*cos£ x + sin£y*sin£ x *sin£ z 

The TSM matrix in the FIT program is derived from 3 rotation matrices 
(denoted R x , Ry, R z ) in the spacecraft coordinate system. R x is a left- 
handed rotation through the angle e x , about the spacecraft X axis. Ry is a 
left-handed rotation about the spacecraft Y axis, with angle of rotation £y. 
R z is a right-handed rotation through the angle £ z , about the spacecraft Z 
axis . 


4 


The matrices R x , Ry and R z are thus 

5) R x = fl 0 

I 

lo cose x 

I 

lo sine x 


R z = f cos£ z sin£ z 0 1 

I I 

l-sin£ z cos£ z 0 I 

I I 

l 0 0 1 J 

Rotations provided by R x , R y and R z are illustrated in Figures la), b) and 
c) in paper 1. 

TSM is created by rotating about the X axis first, then about Z, then 
about Y, e . g. , 

6) TSM = R y *R z *R x 

An older version of the FIT program, documented in Estes (1983), used a 
different order of rotation, about the Z axis first, about the new X axis 
second, and finally about the new Z axis. It is now known that this Z-X-Z 
rotation order fails to adequately resolve the first and third angles when 
they are large, and so the present order of rotation was instituted, with 
successful results. 

The relation of euler angles £ x , £y, £ z to "roll, pitch, yaw notation 
is dependent on the spacecraft axis designations. For example, since the 
MAGSAT Z-axis is pointed in its along- track direction, £ z is roll, 

£ y (radial) is yaw, and £ x (cross track) is pitch. 

The FIT program calculates some field quantities in earth-fixed 
cartesian coordinates. The coordinate origin is at earth’s center; the X 
axis points along 0° longitude; the Y axis points along 90 meridian; and 
the Z axis points along the geographic north pole. Information is therefore 
required on the relation between the corrected spacecraft measurement 
vector, Bspc, and its analog in earth-fixed coordinates Bef, for every data 
point. This information is contained in transformation matrix TGS: 

7 ) Bef = TGS * Bspc 


0 1 R v = I cos £y 0 sm£ y 1 

I I I 

-sin£ x l I 0 1 0 I 

1 1 1 

cos£ x J l-sin£y 0 cosfiyj 
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The TGS matrix itself is an approximation computed from the formula: 


TGS 
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X, and X n are defined as: 

^ = Geocentric latitude 

X = East longitude 

s -8*74°, the inclination of the vector normal to the orbit 

X n = X t arccos [-tan(^ n )*tan(^) ] , where + is used for a 

descending orbit (N to S) and - for an ascending orbit* 


It should be noted that this equation is not accurate for latitudes greater 
than about 75°. DMSP data between 75° and 81.26° were therefore not 
utilized in subsequent analyses. Derivation of this restriction and of the 
TGS transformation elements themselves may be found in Appendix B of paper 
1 . 


Combining equations #3 and #7 yields: 

9) Bef = TGS * TSM * TCAL* (Bspu - bias) 

Bspu and TGS are read or computed from input data, and TSM, TCAL and 
bias are solved for in execution of the FIT program. 


IV. Noise Sources in the Magnetic Data. 


The DMSP data were examined initially by Rich (1984), who found three 
sources of magnetic noise. The first two are high frequency sinusoidal 
signals with periods of 0.576 and 3.456 seconds. These are caused by the 
rotating X-ray scanner, designated the SSB/S instrument, which is mounted 10 
to 15 inches from the magnetometer sensors and generates a small magnetic 
field. These high frequency noise sources are of magnitude less than about 
30 nT and are not a concern in the present study. 
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The third noise source found by Rich is the operation of the satellite 
torquing coils. These are turned on for durations of about 4 minutes at 
various times throughout the DMSP mission. When the coils are on, the 
magnetic field data is offset by a constant level shift of 3000 to 14,000 
nT . This type of noise is screened out by the "gross outlier criterion for 
reducing the data. 

A fourth known noise source consists of fields in the 100 - 150 nT 
range which result from turning on transmitters and tape recorders when over 
a tracking station. It is assumed that most data so affected will be 
eliminated in the various outlier tests. 

A noise source not discussed by Rich(1984) was discovered by examining 
orbital plots of residual data, i.e. data which have had a preliminary field 
model subtracted. These residual data show strong periodic trends with 
amplitudes of up to 70 nT, after other corrections were applied. An in- 
depth discussion of this periodic noise and its removal is found in paper 1. 

V. Automated Clean-Up Procedure for DMSP Data. 


Preliminary field modeling 

A test model was generated from DMSP data at epoch 198A.0A. The gi® 
term from this model equaled -29,900.4 nT. A model derived from observatory 
data at the same epoch yielded gi° equal to -29,883.4. The closeness of the 
two terms suggests the apparent adequacy of the DMSP data for main field 
modeling. A calibration of the 1984.04 data, using the second procedure 
described in the previous section, was also executed with the following 
results: SL1 = 0.9955, SL2 = 0.9996, SL3 = 1.0025. The nearness of these 

values to unity again suggests that the DMSP magnetometer measured the 
magnetic field accurately for that selection of data. These results 
indicated that DMSP data might be useful for main field modeling, in spite 
of the large spacecraft fields. All of these studies were conducted using 
only a few days of data. On the basis of these results, it was decided to 
proceed with a larger quantity of data. 

The preliminary field model was removed from January 14-18 DMSP data to 
create residual data. Upon examination, these orbits of data showed strong 
periodicities. A spectral decomposition of the data revealed noise sources 
with periods equal to the orbit period (100 minutes) and subharmonics of 
1/2, 1/3 and 1/4 of the orbit period. Figure 1 displays a typical residual 
orbit from this time period. The X and Y components most clearly 
demonstrate this periodic noise. Figure 2 is the associated spectrum. 

Peaks in the spectrum display these dominant noise periods quite noticeably. 
As will be seen below, one cause of the periodic noise is the need for 
adjustment of the Euler angle values in the TSM matrix in equation 3). The 
other causes of this periodic noise is unknown. The peak-to-peak amplitude 
of the noise is about 300 nT before Euler angle correction and about 50-70 
nT after that correction. 
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Automated procedure description 


A five-stage clean-up procedure was followed to remove data spikes and 
periodic noise from the DMSP data. In this procedure the data were 
processed through a data cleaning and filtering program written by T.J. 
Sabaka called FILTER. The stages are as follows: 1) Fit a span of DMSP 

data, covering several days, with a preliminary field model. Subtract the 
field model to get residual data. Reject data points above 75° absolute 
latitude, and reject "gross outliers", i.e., residual data with absolute 
values greater than a specified cutoff. Fit the residual data with a spline 
function and reject points which deviate more than 2 standard deviations 
from that function. 2) Add residual data which is not rejected back to the 
preliminary field model. Then fit a new field model to this data with epoch 
equal to the average time of that data span. Solve for constant main field 
coefficients, magnetometer angle adjustments and biases. 3) The new field 
model is reformatted for further use. 4) Correct the original data with the 
angle and bias solutions. Use the computed field from stage #3 to re-create 
the residual data, and re-do step #1, i.e. reject gross outliers and spline 
outliers, 5) Fit a Fourier function, which is composed of the 4 dominant 
noise periods (25 minutes, 33 minutes, 50 minutes and 100 minutes) in a 
least- squares manner to the residual data. Reject outliers according to the 
Fourier fit, using the 20 criterion as for the spline fit. Then subtract 
the Fourier function from the data. Add the result back to the computed 
field model from step #2, to create the final, corrected data set. 

Stage 5) is somewhat ad hoc. Such periodic variations could arise from 
source corrections we have either overlooked or been unable to apply. For 
example, comparison of Figures 3a and 3b shows that much of the large 
periodic oscillation results from unadjusted Euler angles. It is both more 
meaningful and reliable to correct the euler angles than to remove the 
variations via the Fourier fit. For this reason the ad hoc Fourier fit 
correction is applied last. 

Figure 3 shows the same profile from Figure 2, after it has undergone 
the data cleaning process. Most of the periodic noise is gone, and the 
major spikes and outliers have been removed. 

Table 1 summarizes the five stages. The input and output files are 
indicated for each stage. 
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TABLE 1: FIVE STAGE CLEAN-UP PROCESS 


NAME INPUT FILE OUTPUT FILE DESCRIPTION 

(DTAPE. PROCESS) 

STAGE 1 

1) A.F.Tape DATE DATE . STEP1 . OUTBIN Translates magnetometer 

2) DATA.MISC (VBS , lrecl=11204, counts to nT. Fits 

(CAL84FID) Blksize=22412) residual orbits with a 

3 ) XRTJS . BSPINFO • DATA B spline, and flags 

4 ) XRT JS . DMSP . STEP2 . DATA outliers and points with 

" « n 3 it non-determinable 

n « "4 « velocities. Puts data into 

if »i « 5 * FIT binary format. 

STAGE 2 

DATE. STEPl. OUTBIN DATE . STEP2 . COEFFS Fits a field model to 

flagged data. Solves for 
magnetometer corrections 
(euler angles, 
magnetometer biases). 

STAGE 3 

DATE. STEP2. COEFFS DATE . STEP3 . COEFFS Reformats field model. 

STAGE 4 

Same as STAGE 1 DATE . STEP4 . OUTF 
except (FB, lrecl=240, 

DATE. STEP 3. COEFFS Blksize=4800 ) 
is used in place of 
DATA.MISC (CAL84FID) . 

STAGE 5 

DATE. STEP4. OUTF, 1 ) DATE. STEP5. OUTF Fits orbits with periodic 
plus same files 2 ) DATE. STEP5. OUTBIN fourier function, and 

as STEP4. removes this function from 

data. Data is output both 
in formatted and binary 
(FIT) formats. 

(Note: STEPl, STEP4.STEP5 utilize load module XRJRR. SATFILT , which contains 

the FILTER program. STEP2 utilizes module XRJRR. FIT .DMSP .L0AD2 , which 
contains the old FIT program.) 

The output from STAGE1 , DATE. STEPl. OUTBIN, is not saved. 

The output from STAGE 2, DATE. STEP2. COEFFS, becomes file 1 on the output 
tape . 

The output from STAGE 3 , DATE . STEP3 .COEFFS, becomes file 2 on the output 
tape . 

The output from STAGE 4 , DATE. STEP4. OUTF, becomes file 3 on the output tape. 
The output from STAGE 5 , DATE . STEP5 .OUTBIN, becomes file 4 on the output 
tape . 

The output from STAGES, DATE. STEP5. OUTF, becomes file 5 on the output tape. 


Same function as STEPl, 
but with a different 
field model. 
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Use of the FILTER Program 


As noted, the five stages of the cleanup procedure are based on the 
program FILTER. Filter is comprised of five steps, each modularly designed. 
[Not to be confused with the "stages" in Table 1 and accompanying text.] 

STEP 1: Involves reading of an original satellite magnetic data tape and 

transforming the raw magnetometer counts to magnetic field values in the 
spacecraft coordinate system. 

STEP 2: Involves the location and padding of time gaps in the data and the 

determination of the direction of the spacecraft velocity vector at each 
measurement location. 

STEP 3: Involves the transformation of the magnetic field measurements 

from spacecraft to topocentric coordinate system from which residual 
measurements are determined from a given field model. Data locations at 
which any vector residual exceeds the specified tolerance are flagged as 
outliers . 

STEP 4: Involves fitting a trend to the magnetic field residuals with B- 

Splines and/or fourier waveforms, with the option of flagging points whose 
trend residuals exceed a given tolerance and the option of detrending the 
original data. 

STEP 5: Involves outputting a final modified satellite magnetic tape in 

three basic forms: 

1) EBCDIC tape in topocentric coordinates 

2) EBCDIC tape in desired spacecraft coordinates 

3) Binary tape in old fit program format (Magsat convention) 

Program FILTER may run in one of four modes indicated by the input variable 
IMODE : 

IMODE = 0: Perform steps 1, 2, 3, 4, and 5. 

IMODE = 1: Perform steps 4 and 5. 

IMODE = 2: Perform step 4. 

IMODE = 3: Perform steps 1, 2, 3, and 4. 

The reader will note that program FILTER is very general. It use in 
processing DMSP data is a special case. 

The correspondence between IMODE and the STAGE’S of Table 1 is as follows: 
STAGE 1: IMODE = 0 

STAGE 4: IMODE = 0 

STAGE 5: IMODE = 1 

STAGE 2 consists of running the old version of the FIT (Main Field Modeling) 

Program. For future work, this step must be modified to use the new FIT 
program. 
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STAGE 3 is a simple program which modifies the format of the SHA 
coefficients output from STAGE 2. When output they are in the standard 
format for the old FIT program. This stage converts the coefficients into 
the format needed by the program FID. FID is the standard program to 
compute magnetic field at a specified time and location from a set of SHA 
coefficients . 

Automated Procedure Deck Setup 

Typical setup (JCL) decks, annotated, for the five stages are as 
follows : 

A. For STAGE’S 1, 4, and 5, using program FILTER: 

In these listings XRJRR. SATFILT is the location of the load module for the 
FILTER program. The source code is presently in XRTJS.DMSP.FILT.CNTL. In 
the future both, as well as the run decks printed on the next few pages, 
will be saved on a cartridge. Details will be given later in this report. 

SATFILT is a combination of the basic programs FILTER and BSPLYN3, with 
slight modifications for use with DMSP data. These modifications have to do 
with data plotting. The original programs produced plot output for use in 
the WOLFPLOT plotting package. The modifications permit plotting using the 
DIUTIL plot package. The modifications are used in conjunction with program 
ADDFLAG whose purpose is to create an ASCII file from program FILTER output 
which has both a residual field (core model subtracted) and a B-spline fit 
to that field, versus time in minutes, for one orbit. Points which are 
outliers from the B-spline fit are flagged. INOTE is the flag. When a data 
point has a value of INOTE of 1, 2, or 6, the data point is not output. The 
code to produce the plotting output requires the following code additions: 

In BSPLOT : 

********************************************************************* 
CHARACTER*! SYMBOL (5), BLANK 
DATA BLANK / ’ ’ / 

********************************************************************** 


After the following CODE, place the CODE between the asterisks: 


26 CALL OGRID(XMIN, XMAX, LINT , IXFMT , 1 , PMIN, PMAX.MINT , IYFMT ,2,0) 

IF(II.EQ.l) CALL PLOT (XS.SS, NOBS, ’X’) 

CALL PLOT (XS, VS, NOBS, ’ ’) 

********************************************************************** 


665 


31 


WRITE (25, 665) 

FORMAT (IX, ’RAW DATA (FIRST) AND B-SPLINE FIT’) 
DO 31 KKK=1 , NOBS 

WRITE (25, 666 ) XS (KKK) ,SS(KKK) ,VS(KKK) 

WRITE (25, 667) BLANK 
FORMAT (3F10. 3) 

FORMAT (Al) 



DO 59 JL=1,LTYPER 
NKNT=KK( JL) 
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This code outputs to unit 25, which should be allocated in the JCL as a 
fixed-block ASCII file. After FILTER has been run and the output of unit 25 
saved, ADDFLAG should be run. 

Inputs to ADDFLAG: Unit 10 - file created by FILTER unit 25 

Unit 15 - file created by FILTER unit 15 
=DATE . STEP4 . OUTF 

Output from ADDFLAT: Unit 20. Another fixed-block ASCII file with format: 

Title ( 7 2A1 ) 

Time (min), Residual (nT) , B-spline value (nT), Flag - (3F10.3.I5) 

. . . Data values repeated N times . . . 

Blank line 

This sequence is repeated three times, one for each component (X, Y, Z). 

The ASCII file is plotted with DIUTIL plotting program DPL0T1, which inputs 
it on unit 8 and outputs a plot file using standard DIUTIL commands. 

ADDFLAG2: is a simpler version of ADDFLAG, which outputs an ASCII file of 
Fourier detrended points after running FILTER, step 5. ADDFLAG2 does not 
require special code to be inserted into FILTER. It writes out only points 
with INOTE = 0,3, 4, 5. 

Input to ADDFLAG 2 : Unit 15 - file created by FILTER unitl5 = 

DATE. STEP5. OUTF. 

Output from ADDFLAG2: An ASCII file in the same format as that produced by 
ADDFLAG and which may be plotted by program DPL0T1. 

Note that Unit 10 contains the input DMSP data and that OPTCD=Q means that 
an ASCII file is expected. 

Unit 15 is FILTER output in EBCDIC, in topocentric coordinates. Unit 17 is 
output in old FIT format, Binary, using Magsat coordinates. Unit 12 is the 
input field model coefficients and Unit 22 contains B-Spline and Fourier 
series information. 

Other programs related to FILTER and to DMSP data processing are: BSIG, and 
POWPLT. BSIG calculates the mean and standard deviation of DMSP data 
relative to a given field model. It also calculates the dipole latitude of 
the data and will not use data above a specified dipole latitude. It only 
considers "good" points, i.e. with INOTE =0. It presently compares the 
DMSP data to the field model values contained on DATE. STEP5. OUTF; however, 
it may be modified to use an arbitrary field model by removing the comment 
cards from the section of code which calls the FID program. Inputs are on 
Unit 8 and Unit 10: Unit 8 is used for field model coefficients in FID 
format, if using an arbitrary model, otherwise this unit is not needed. 

Unit 10 = DATE. STEP (1, 4,5) .OUTF is an ASCII file output from step 1, 4 or 5. 
The output is in printed format only. 
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POWPLT is a wolfplot power spectrum plotting routine. It may run on any 
file which has the correct input format, but was created specifically to 
plot power spectra output by the following code inserted into program 
FILTER, subroutine SPECT, following the code before the asterisk: 

IF(PLT.EQ.l) CALL PLOT (PERIOD, AMP, LTOTL, ’ ’) 

IF(PLT.EQ.2) CALL PLOT (PERIOD, PHI, LTOTL, ’ ’) 

IF(PLT.EQ.3) CALL PLOT (PERIOD, POWER, LTOTL, ’ ’) 
********************************************************************* 
WRITE(26, 670) 

670 FORMAT (IX, ’PERIOD AND POWER SPECTRUM’) 

DO 33 KKK=1, LTOTL 

33 WRITE(26, 672) 

671 FORMAT (2E15 . 8 ) 

672 FORMAT (’ ’) 

********************************************************************* 

C 

C PRINT HEADING 

When FILTER is run with the inserted code, a fixed block ASCII file in the 
following format is output to unit 26: 

Title (A72) 

Period Power (2E15.8, repeated N times) 

Blank line 

>entire sequence repeated three times, once for each component. 


This file is then input into POWPLT, which outputs a plot file onto unit 8, 
which for WOLFPLOT is a plot tape. 

Use of Dst . Dst is added to DMSP data for use in the old FIT program. The 
program which does this is DSTADD . DSTADD requires Dst values in a certain 
format: (2X, 12, 13, 2X, 2414), where the first variable is year past 1900, 
the second is day of year, followed by 24 Dst values for that day. The 
original data tape containing Dst (TD5696) is not in this format, but must 
be processed through DST1 (located on DMSP . PROGRAMS) to create a file 
suitable for input into DSTADD. DST1 also windows DST values according to 
date . 

The functioning of Program FILTER depends on the input variables specified 
in various NAMELIST statements. The following pages are a Glossary of the 
various variables that can be set in this manner. 
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GLOSSARY OF PROGRAM FILTER NAMELIST ITEMS 


NAMELIST IOFILE - 


IST1 - INPUT UNIT FOR ORIGINAL RAW DATA TAPE(S) IN STEP1 . 

IST2 - INPUT UNIT IN STEP2, OUTPUT UNIT IN STEP1, MAGNETIC FIELD 

IN FIT/MAGSAT COORDINATES . 

IST3 - INPUT UNIT IN STEP3 , OUTPUT UNIT IN STEP2, VELOCITY 
DIRECTIONS AND PADDED TIME-GAPS. 

IST4 - INPUT UNIT IN STEP4, OUTPUT UNIT IN STEP3 , MAGNETIC FIELD 
AND RESIDUALS IN TOPOCENTRIC COORDINATES. 

IOR - FILTER INPUT UNIT, SAME AS IST4 IN OPERATION MODE 0 
AND 3. 

IOW - FILTER OUTPUT UNIT, INPUT UNIT IN STEPS. 

IOF - OUTPUT UNIT IN STEPS, FORMATTED MAGNETIC FIELD IN FIT / 
MAGSAT OR TOPOCENTRIC COORDINATES DEPENDING ON IBTBS 
VALUE. 

IOD - OUTPUT UNIT IN STEP5 , FORMATTED MAGNETIC FIELD IN DESIRED 
SPACECRAFT COORDINATES. 

IOB - OUTPUT UNIT IN STEPS, BINARY MAGNETIC FIELD IN PROGRAM 
FIT FORMAT. 

ISC1 - FILTER SCRATCH UNIT. 

ISC2 - FILTER SCRATCH UNIT. 

ISC3 - SCRATCH UNIT USED IN SUBPROGRAM DPINFO TO STORE VARIOUS 
DATA PARAMETERS. 
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NAMELIST FIELDP - 


JJ - FID INPUT POSITION COORDINATES: (0) GEODETIC 

(1) GEOCENTRIC. 

MM - FID EQUITORIAL RADIUS AND RECIPROCAL FLATTENING: 

(0) DEFAULT AE = 6378.16 KM, FLAT = 298.25 (1) INPUT 
VALUES. 

NMX - MAXIMUM DEGREE OF FID MODEL EVALUATION. 

NEXT - EXTERNAL FIELD MODEL: (0) DO NOT EVALUATE (1) EVALUATE. 

IOCF - INPUT UNIT IN FID FOR COMPUTED MAGNETIC FIELD MODEL. 

IDST - INDUCED FIELD COEFFICIENTS: (0) DO NOT EVALUATE 

(1) EVALUATE. 

DST - DST VALUE. 

LL - FID FIELD EVALUATION MODE: (-1) EVALUATE AT OLD TIME 

(0) EVALUATE (1) READ FIELD MODEL AND EVALUATE. 

NAMELIST BSPLIN - 


H - ARRAY CONTAINING NUMBER OF INTERNAL KNOTS FOR B- SPLINE 

FUNCTIONS FITTING X, Y, AND Z COMPONENTS, RESPECTIVELY. 

NN - ARRAY CONTAINING ORDER OF B-SPLINE FUNCTIONS FITTING X, 

Y, AND Z COMPONENTS, RESPECTIVELY. 

NT - ARRAY CONTAINING NUMBER OF FOURIER WAVEFORMS FITTING X, 

Y, AND Z COMPONENTS, RESPECTIVELY. 

KA - B-SPLINE INTERNAL KNOT ADJUSTMENT FOR BEST FIT WITH 

RESPECT TO WEIGHTED RMS: (0) DO NOT ADJUST (1) ADJUST 

ITERMX - MAXIMUM NUMBER OF ITERATIONS IN UNIVARIANT SEARCH FOR 
OPTIMUM B-SPLINE KNOT POSITIONS. 

LGRMAX - MAXIMUM NUMBER OF ITERATIONS IN LAGRANGIAN INTERPOLATIVE 
SEARCH FOR BEST POSITION OF A PARTICULAR KNOT WITH 
RESPECT TO WEIGHTED RMS. 

EPS - KNOT ADJUSTMENT TOLERANCE WITHIN WHICH THE KNOT POSITION 
IS CONSIDERED TO HAVE CONVERGED. 

KO - BOOLEAN NUMBER IN WHICH EACH DIGIT GOVERNS THE ADJUSTMENT 

OF A PARTICULAR INTERNAL KNOT POSITION, WITH LEFT-MOST 
DIGIT CORRESPONDING TO LEFT -MOST KNOT: (0) ADJUST 

(1) DO NOT ADJUST. 
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IOBS - INPUT UNIT CONTAINING B-SPLINE KNOT POSITIONS , FOURIER 
WAVEFORM FREQUENCIES, AND SIGMAS FOR OBSERVED MAGNETIC 
FIELD VALUES. 

NAMELIST TRFORM - 


EU - FIT EULER ANGLES (DEGREES). 

QI - GSFC NOMINAL BIAS CORRECTIONS IN ORIGINAL SATELLITE 
COORDINATES (NT). 

QF - FIT MAGNETOMETER BIAS ADJUSTMENTS (NT). 

CF - FIT CALIBRATION SLOPE ADJUSTMENT MATRIX. 

CA - CALIBRATION MATRIX IN ORIGINAL SATELLITE COORDINATES. 

RF - ROTATION MATRIX FROM ORIGINAL SATELLITE TO FIT/MAGSAT 

COORDINATES. 

RC - ROTATION MATRIX FROM FIT/MAGSAT TO DESIRED SATELLITE 
COORDINATES. 

NAMELIST CONTRL - 


IMODE - PROGRAM OPERATION MODE: (0) RAW-TO-FINAL FIT TAPE TOTAL 

PROCESSING (1) FILTER-TO-FINAL FIT TAPE PROCESSING 
(2) FILTER PROCESSING ONLY (3) RAW-TO-FILTER TAPE 
PROCESSING. 

IFORM - ORIGINAL RAW DATA TAPE(S) FORMAT: (0) EARLY FORMAT -- 

2 SAMPLES /SECOND (1) LATTER FORMAT -- 20 SAMPLES / SECOND 

NDATAR - NUMBER OF DATA RECORDS PROCESSED AFTER EPHEMERIS RECORD. 

INPUTF - NUMBER OF INPUT FILES TO BE PROCESSED. 

IARC - ARC PROCESSING LENGTH: (0) ENTIRE ARC (1) ARC SEGMENT 

BETWEEN BEGINNING AND ENDING TIMES ONLY. 

IYRBEG - BEGINNING ARC TIME YEAR SINCE 1900. 

IDYBEG - BEGINNING ARC TIME DAY NUMBER. 

ISCBEG - BEGINNING ARC TIME SECONDS. 

IYREND - ENDING ARC TIME YEAR SINCE 1900. 

IDYEND - ENDING ARC TIME DAY NUMBER. 
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ISCEND - ENDING ARC TIME SECONDS. 

ORBINC - SATELLITE ORBIT INCLINATION ANGLE (DEGREES). 

ERAD - MEAN EARTH RADIUS (KM) . 

IEPDAY - FILTER REFERENCE DAY NUMBER. 

INCREM - FILTER WINDOW LENGTH (SECONDS). 

INTRVL - FILTER WINDOW NUMBER FROM BEGINNING OF REFERENCE DAY . 

IMETH - FILTER METHOD: (0) DETREND (1) DETREND AND FLAG 

OUTLIERS (2) FLAG OUTLIERS (3) NO MODIFICATION. 

ISPEC - FFT SPECTRAL ANALYSIS: (0) NO ANALYSIS (1) ZERO-MEAN 

ANALYSIS (2) DIRECT ANALYSIS. 

NEXTIN - NUMBER OF SUCCESSIVE FILTER WINDOWS TO BE PROCESSED 

DURING THIS RUN BEGINNING WITH WINDOW NUMBER "INTRVL". 

IBTBS - FINAL TAPE OUTPUT COORDINATES: (0) FORMATTED TOPOCENTRIC 

(1) FORMATTED /BINARY FIT/MAGSAT (2) SAME AS 1, PLUS 
FORMATTED DESIRED SATELLITE. 

SIGMLT - OUTLIER MULTIPLICATION FACTOR FOR TREND RESIDUAL SIGMA. 

NFLAGK - DATA QUALITY FLAG RETENTION CODE FOR FILTER: EACH DIGIT 

INDICATES FLAG TO BE RETAINED FOR TREND FITTING. 

IOWIOF - UNIT IOW INTERVALS FOR FINAL PROCESSING: (0) INTRVL ONLY 

(1) INTRVL AND PRECEEDING (2) ALL. 

IOF1ST - OUTPUT DATA FLAG FOR UNITS IOF AND IOB: (0) DATA WILL BE 

APPENDED (1) DATA WILL BE FIRST. 

IOD1ST - OUTPUT DATA FLAG FOR UNIT IOD: (0) DATA WILL BE APPENDED 

(1) DATA WILL BE FIRST. 

IOW1ST - OUTPUT DATA FLAG FOR UNIT IOW: (0) DATA WILL BE APPENDED 

(1) DATA WILL BE FIRST. 

NAMELIST OUTLIM - 


DXOL - MAGNITUDE TOLERANCE FOR RESIDUAL TOPOCENTRIC X 
COMPONENT (NT). 

DYOL - MAGNITUDE TOLERANCE FOR RESIDUAL TOPOCENTRIC Y 
COMPONENT (NT). 

DZOL - MAGNITUDE TOLERANCE FOR RESIDUAL TOPOCENTRIC Z 
COMPONENT (NT). 
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DBOL 

XWINDO 

YWINDO 

ZWINDO 

BWINDO 

ABVLAT 

TRNLAT 

ITMGAP 


MAGNITUDE TOLERANCE FOR RESIDUAL TOPOCENTRIC B 
COMPONENT (NT). 

MAGNETIC LATITUDE TOLERANCE FOR FIT/MAGSAT X COMPONENT. 

MAGNETIC LATITUDE TOLERANCE FOR FIT/MAGSAT Y COMPONENT. 

MAGNETIC LATITUDE TOLERANCE FOR FIT/MAGSAT Z COMPONENT. 

MAGNETIC LATITUDE TOLERANCE FOR FIT/MAGSAT B COMPONENT. 

FILTER GEOCENTRIC LATITUDE TOLERANCE FOR ALL COMPONENTS. 

GEODETIC LATITUDE ABOVE WHICH SATELLITE VELOCITY 
DIRECTION IS INDETERMINABLE. 

TIME-GAP TOLERANCE INCREMENT FOR DATA (SECONDS). 
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RUN DECK FOR STAGE 1 


//X RJRRST1 JOB (F8002 ,X22 , 80 ) , STEP1 , TIME= (5 , 00 ) , CLASS=A,MSGCLASS=X 

/★JOBPARM LINES=100 

II GO EXEC PGM=L0AD1 , REGION=3000K 

II STEPLIB DD DISP=SHR, DSN=XRJRR. SATFILT 

II* 

II* UNIT FOR INPUT PARAMETERS FOR PROGRAM FILTER FOLLOWS 

II* 

II GO.FT05F001 DD * 

DMSP MAR 19-21, 1984. STEP1 WITHOUT COORDINATE SWITCH 1 - RF=I MATRIX! 
&CONTRL IMODE=0 , IFORM=l, IARC=0, ORBINC=98 . 74 , IEPDAY=79, 

INCREM=21600 , INTRVL=1, IMETH=2, ISPEC=1, NEXTIN=12, 

I0F1ST=1, INPUTF=1 , &END 
&IOFILE IOR=13 , IOW=14 , ScEND 

&BSPLIN H ( 1 ) =17 , H (2 ) =17 , H(3)=17, NT(1)=0, NT(2)=0, NT(3)=0, 

NN ( 1 ) =4 , NN(2)=4, NN(3)=4, &END 
&OUTLIM , &END 
&FIELDP , &END 

&TRFORM RF ( 1 , 1 ) =0 . 0 , RF(1,2)=0.0, RF(1,3)=1.0, 

RF ( 2 ,1 ) =1 . 0 , RF(2,2)=0.0, RF(2,3)=0.0, 

RF( 3 , 1)=0 . 0 , RF ( 3 , 2) =1 . 0 , RF(3,3)=0.0, 

CA( 1 , 1 ) =12 . 1001 , CA (1,2) =-0.0055, CA(1,3)= 0.0193, 

CA( 2 ,1)=- 0.0247, CA( 2 , 2) =12 . 1863 , CA( 2, 3 )=-0 . 0101 , 

CA ( 3 , 1 ) = 0.0069, C A (3,2)= 0.0232, CA(3,3)=12.1735, 

QI ( 1) =89 . 0 , QI (2 ) =8457 . 0 , QI (3 ) =-1441 . 0 , 

EU ( 1) =0 . 00 , EU(2 )=0 . 00 , EU(3)=0.00, JtEND 

II* 

II* PRINTER OUTPUT UNIT FOLLOWS 

II* 

II GO.FT06F001 DD SYSOUT=*, SPACE=(CYL, (20,9) ,RLSE) 

II* 

II* PLOT TAPE UNIT FOLLOWS (RARELY USED, SO DUMMY OUT) 

II* 

II* GO.FT08F001 DD UNIT= (1600, .DEFER) , LABEL= ( 1 , NL , , OUT) , 

1 1* DCB= (RECFM=VBS , LRECL=364 , BLKSIZE=368 , DEN=3 ) , VOL=SER=JRR001 
/ /GO . FT08F001 DD DUMMY 

II* 

II* NEW- FORMAT SATELLITE MAGNETIC TAPE UNIT FOLLOWS 

II* 

IIG O.FTlOFOOl DD DISP=( OLD, KEEP) ,UNIT=6250 ,LABEL=(1,NL, ,IN) , 

/ / DCB= ( RECFM=FB , LRECL=75 , BLKSIZE=1875 , DEN=4 , OPTCD=Q) , VOL=SER=DT0031 

II* 

II* PERMANENT RE-USABLE DATA SETS FOLLOW (LEAVE AS IS ON STEP1) 

II* 

II GO.FTllFOOl DD DSN=XRTJS. DMSP. STEP2. DATA, DISP=SHR 
/ /*DCB= (RECFM=FB , LRECL=240 , BLKSIZE=4800 ) ,UNIT=SYSDA, 

/ /*SPACE=(TRK, (20,10) ,RLSE) , VOL=SER=SACC09 
/ /GO . FT12F001 DD DSN=XRTJS .DMSP . STEP3 . DATA, DISP=SHR 
/ / *DCB= (RECFM=FB , LRECL=240 , BLKSIZE=4800 ) , UNIT=SYSDA, 

/ /*SPACE=(TRK, (20,10) , RLSE) , V0L=SER=SACC05 

//♦O.FT13F001 DD DSN=XRJRR. DMSP. STEP1S . JAN17 . DATA, DISP=SHR 

II GO.FT13F001 DD DSN=XRTJS. DMSP. STEP4. DATA, DISP=SHR 
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//GO.FT14F001 DD DSN-XRTJS .DMSP . STEPS . DATA, DISP-SHR 

II * 

II * 

II* RUN- SPECIFIC OUTPUT DATA SETS FOLLOW 

II* 

II GO.FT15F001 DD DUMMY, DSN=XRSHS . SEP1684 . STEP1 ,OUTF,DISP= (NEW, CATLG) , 
II DCB= (RECFM=FB , LRECL-240 , BLKSIZE=4800 ) , UNIT-SYSDA, 

II SPACE- (TRK, (20,10) ,RLSE) , VOL-SER-SACC02 
/ /GO . FT17F001 DD DSN-XRJRR.EUTEST .MAR1984 . STEPl.DISP-SHR 
/ / *DCB=(RECFM=VBS , LRECL-11204 , BLKSIZE-22412) , UNIT-SYSDA, 

/ / *SPACE= ( TRK, (20,10) , RLSE) , VOL-SER-SACC06 

II* 

II* SCRATCH DATA SETS FOLLOW 
II* (BINARY, WILL NEVER LOOK AT) 

/ /GO . FT18F001 DD UNIT-SYSDA, DISP=( .PASS) ,SPACE=(TRK, (2,1) , RLSE) , 

/ / DCB- (RECFM-FB , LRECL-80 , BLKSIZE-7200 ) 

/ /GO . FT19F001 DD UNIT-SYSDA, DISP=( .PASS) ,SPACE=(TRK, (2,1) .RLSE) , 

/ / DCB- (RECFM-FB , LRECL-80 , BLKSIZE-7200 ) 

II GO.FT20F001 DD UNIT-SYSDA, DISP=( , PASS) , SPACE=(TRK, (2, 1) , RLSE) , 

/ / DCB- (RECFM-FB , LRECL-80 , BLKSIZE-7200 ) 

II* 

II* INPUT MAGNETIC FIELD DATA SET FOLLOWS 
II* (KEEP AS IS FOR STEP1) 

/ /GO . FT21F001 DD DSN=XRJRR.DATA.MISC(CAL84FID) .DISP-SHR 

II* 

II* INPUT TREND-FIT DATA SET FOLLOWS 

II* 

/ /GO .FT22F001 DD DSN-XRTJS.BSPINFO. DATA, DISP-SHR 

II* 

II* SYSTEM DUMP FOR ABEND-AID FOLLOWS 

II* 

II GO.SYSUDUMP DD DUMMY 
II EXEC NOTIFYTS 
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RUN DECK FOR STAGE 4 

//X RJRRST4 JOB (F8002 ,X22, 80) , STEP4 , TIME=( 10 , 00) ,CLASS=F,MSGCLASS=X 

/* JOBPARM LINES=100 

II GO EXEC PGM=L0AD1 , REGION=3000K 

II STEPLIB DD DISP=SHR,DSN=XRJRR. SATFILT 

II * 

II* UNIT FOR INPUT PARAMETERS FOR PROGRAM FILTER FOLLOWS 

II* 

II GO.FT05F001 DD * 

DMSP SEP 16,18 1984. INPUT FIELD FROM FIT. STEP4 . 

&CONTRL IMODE=0 , IFORM=l , IARC=0 , ORBINC=98 . 74, IEPDAY=260, 
INCREM=21600 , INTRVL=1, IMETH=2, ISPEC=1, NEXTIN=12, 

I0F1ST=1 , INPUTF=1 , JcEND 
&IOFILE IOR=13 , IOW=14 , SEND 

&BSPLIN H(l)=17, H(2)=17, H(3)=17, NT(1)=0, NT(2)=0, NT(3)=0, 
NN(1)=4, NN ( 2) =4 , NN(3)=4, &END 
&OUTLIM , SEND 
&FIELDP , &END 

&TRFORM RF(1 , 1)=0 . 0 , RF(1,2)=0.0, RF(1,3)=1.0, 

RF ( 2 , 1 ) =1 . 0 , RF ( 2 , 2 ) =0 . 0 , RF(2,3)=0.0, 

RF (3 , 1 ) =0 . 0 , RF ( 3 , 2 ) =1 . 0 , RF(3,3)=0.0, 

CA( 1 ,1)=12.1001, CA( 1 ,2) =-0.0055, CA(1,3)= 0.0193, 

CA(2, 1)=- 0.0247, CA(2, 2)=12 . 1863 , CA(2,3)=-0.0101, 

CA (3,1)= 0.0069, C A (3,2)= 0.0232, CA(3 , 3)=12 . 1735 , 

QI (1 ) =89 . 0 , QI (2) =8 457.0, QI (3 ) =-1441 . 0 , 

EU(1)=-. 47839 EU(2)=-. 09246, EU(3)=-0. 00609, 

QF ( 1) — 18 . 4 , QF ( 2) =-9 . 46 , QF ( 3 ) =-2 . 35 , SEND 

II* 

II* PRINTER OUTPUT UNIT FOLLOWS 

II* 

II GO.FT06F001 DD SYSOUT=*, SPACE=(CYL, (20,9) ,RLSE) 

II* 

II* PLOT TAPE UNIT FOLLOWS (RARELY USED, SO DUMMY OUT) 

II* 

II* GO.FT08F001 DD UNIT=(1600 , .DEFER) , LABEL= ( 1 , NL , .OUT) , 

/ /*DCB= (RECFM=VBS , LRECL=364 , BLKSIZE=368 , DEN=3 ) , VOL=SER=JRR001 
/ /GO . FT08F001 DD DUMMY 

II* 

II* NEW- FORMAT SATELLITE MAGNETIC TAPE UNIT FOLLOWS 

II* 

II GO.FTlOFOOl DD DISP= (OLD, KEEP) ,UNIT=6250,LABEL=(1,NL, ,IN) , 

/ / DCB= ( RECFM=FB , LRECL=75 , BLKSIZE=1875 , DEN=4 , OPTCD=Q ) , VOL=SER=DT0108 

II* 

II* PERMANENT RE-USABLE DATA SETS FOLLOW (LEAVE AS IS ON STEP1) 

II* 

II GO.FTllFOOl DD DSN=XRTJS. DMSP. STEP2. DATA, DISP=SHR 
/ / *DCB= (RECFM=FB , LRECL=240 , BLKSIZE=4800 ) , UNIT=SYSDA, 

/ / *SPACE= ( TRK, (20,10), RLSE ) , VOL=SER=SACC09 
/ /GO . FT12F001 DD DSN=XRTJS .DMSP. STEP3 .DATA, DISP=SHR 
/ / *DCB= (RECFM=FB , LRECL=240 , BLKSIZE=4800 ) ,UNIT=SYSDA, 

/ /*SPACE=(TRK, (20,10) , RLSE) , VOL=SER=SACC05 

II* O.FT13F001 DD DSN=XRJRR. DMSP . STEP1S .JAN17 .DATA, DISP=SHR 
/ /GO . FT13F001 DD DSN=XRTJS .DMSP . STEP4 .DATA, DISP=SHR 
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/ /GO.FT14F001 DD DSN=XRTJS .DMSP . STEP5 .DATA, DISP=SHR 

II * 

II * 

//* RUN-SPECIFIC OUTPUT DATA SETS FOLLOW 

II* 

II GO.FT15F001 DD DSN=XRSHS . SEP1684 . STEP4 .OUTF,DISP=(NEW,CATLG) , 
II DCB= ( RECFM=FB , LRECL=240 , BLKSIZE=4800 ) ,UNIT=SYSDA, 

II SPACE=(TRK, (20,10) ,RLSE) , VOL=SER=SACC04 
//GO.FT17F001 DD DUMMY 

II* 

II* SCRATCH DATA SETS FOLLOW 
II* (BINARY, WILL NEVER LOOK AT) 

/ /GO.FT18F001 DD UNIT=SYSDA, DISP=( ,PASS) ,SPACE=(TRK, (2,1) ,RLSE) , 
/ / DCB=(RECFM=FB , LRECL=80 , BLKSIZE=7200) 

/ /GO.FT19F001 DD UNIT=SYSDA, DISP=( .PASS) , SPACE* (TRK, (2,1) ,RLSE) , 
II DCB= ( RECFM=FB , LRECL=8 0 , BLKS IZE=7200) 

/ /GO.FT20F001 DD UNIT=SYSDA,DISP=( .PASS) ,SPACE=(TRK, (2,1) ,RLSE) , 
/ / DCB= ( RECFM=FB , LRECL=80 , BLKSIZE=7200 ) 

II* 

II* INPUT MAGNETIC FIELD DATA SET FOLLOWS 
II* (PUT FILE FROM STEPS HERE) 

II GO.FT21F001 DD DSN=XRSHS . SEP1684 . STEP3 . COEFFS , DISP=SHR 

II* 

II* INPUT TREND-FIT DATA SET FOLLOWS 

II* 

II GO.FT22F001 DD DSN=XRTJS .BSPINFO.DATA,DISP=SHR 

/I* 

II* SYSTEM DUMP FOR ABEND-AID FOLLOWS 

II* 

//GO.SYSUDUMP DD DUMMY 
II EXEC NOTIFYTS 
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RUN DECK FOR STAGE 5 


//X RJRRST5 JOB (F8002,X22,50) , STEPS , TIME=(10 , 00) ,CLASS=F,MSGCLASS=X 

/* JOBPARM LINES=150 

II GO EXEC PGM=LOAD1,REGION=3000K 

II STEPLIB DD DISP=SHR,DSN=XRJRR. SATFILT 

II* 

II* UNIT FOR INPUT PARAMETERS FOR PROGRAM FILTER FOLLOWS 

II* 

II GO.FT05F001 DD * 

MAY 6-8,1984. STEP5 . FOURIER REMOVAL STEP, USING NEW FIELD MODEL. 
&CONTRL IM0DE=1 , IF0RM=1 , IARC=0 , 0RBINC=98 . 74, IEPDAY=127 , INCREM=21600 , 
INTRVL=1 , IMETH=1 , ISPEC-1, NEXTIN=12, SIGMLT=2 . 8 , 

I0F1ST=1 , INPUTF=1, SEND 
&IOFILE I0R=13 , I0W=14, SEND 

&BSPLIN H(l)=17, H(2)=17, H(3)=17, NT(1)=4, NT(2)=4, NT(3)=4, 

NN(1)=0, NN(2)=0, NN(3)=0, SEND 
&OUTLIM , &END 
&FIELDP , &END 

&TRFORM RF(1 , 1)=0 . 0 , RF(1,2)=0.0, RF(1,3)=1.0, 

RF(2 , 1)=1 . 0 , RF ( 2 , 2 ) =0 . 0 , RF(2,3)=0.0, 

RF ( 3 , 1 ) =0 . 0 , RF(3,2)=1.0, RF(3,3)=0.0, 

CA(1 , 1) =12. 1001, CA( 1 ,2)=-0.0055, CA(1,3)= 0.0193, 

CA(2 , 1)=- 0.0247, CA(2 , 2) =12 . 1863 , CA(2, 3 )=-0 . 0101 , 

C A ( 3 , 1 ) = 0.0069, C A ( 3 , 2 ) = 0.0232, CA(3,3)=12.1735, 

QI ( 1) =89 . 0 , QI ( 2) =8457 . 0 , QI ( 3 ) =-1441 . 0 , 

EU(1)=0 .000 , EU(2)=0 . 000 , EU(3)=0.000, SEND 

II* 

II* PRINTER OUTPUT UNIT FOLLOWS 

II* 

II GO.FT06F001 DD SYSOUT=*, SPACE=(CYL, (20,9) ,RLSE) 

II* 

II* PLOT TAPE UNIT FOLLOWS 

II* 

II* GO.FT08F001 DD UNIT=(1600, .DEFER) , LABEL= ( 1 , NL , , OUT) , 

/ /*DCB= (RECFM=VBS ,LRECL=364 , BLRSIZE=368 , DEN=3 ) , VOL=SER=JRR001 
/ /GO . FT08F001 DD DUMMY 

II* 

II* DO NOT USE UNIT/10 FOR THIS STEP. 

/ /GO . FT10F001 DD DUMMY 

II* 

II* PERMANENT RE-USABLE DATA SETS FOLLOW 

II* 

//GO.FTllFOOl DD DSN=XRT JS . DMSP . STEP2 . DATA , DISP=SHR 
/ / *DCB= ( RECFM=FB , LRECL=240 , BLKSIZE=48 00 ) , UNIT=SYSDA, 

/ /*SPACE=(TRK, (20,10) , RLSE) , VOL=SER=SACC09 
/ /GO.FT12F001 DD DSN=XRTJS .DMSP . STEP3 . DATA, DISP=SHR 
/ / *DCB= (RECFM=FB , LRECL=240 , BLKSIZE=4800 ) , UNIT=SYSDA, 

//* SPACE=(TRK, (20,10) , RLSE) , VOL=SER=SACC05 

II* 
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II*** INPUT ON UNIT #13, WHICH IS THE OUTPUT FROM STEP4 (FORMATTED). 
/ /GO.FT13F001 DD DSN=XRSHS.MAY684.STEP4.0UTF,DISP=SHR 

II* 

II GO.FT14F001 DD DSN=XRTJS.DMSP. STEPS. DATA, DISP=SHR 
/ / *DCB= ( RECFM=FB , LRECL=240 , BLKSIZE=4800 ) , UNIT=SYSDA, 

/ / *SPACE= ( TRK , (20,10) ,RLSE) , VOL=SER=SACC08 

II* 

II* 

II* RUN-SPECIFIC OUTPUT DATA SETS FOLLOW 

II* (OUTPUT BOTH FORMATTED AND BINARY DATA SETS). 

II GO.FT15F001 DD DSN=XRSHS .MAY684 .STEPS .OUTF,DISP= (NEW, CATLG) , 

II VOL=SER=SACC04 , SPACE= ( TRK, (20,10) ,RLSE) ,UNIT=SYSDA, 

/ / DCB= ( RECFM=FB , LRECL=240 , BLKSIZE=4800 ) 

/ /GO . FT17F001 DD DSN=XRSHS .MAY684 . STEP5 . OUTBIN,DISP=(NEW, CATLG) , 

II VOL=SER=SACC04 , SPACE= (TRK, (20 , 10) , RLSE) ,UNIT=SYSDA, 

/ / DCB=(RECFM=VBS , LRECL=11204 , BLKSIZE=22412) 

II* 

II* SCRATCH DATA SETS FOLLOW 
II* (BINARY, WILL NEVER LOOK AT) 

/ /GO.FT18F001 DD UNIT=SYSDA, DISP=( , PASS ) , SPACE=(TRK, (2,1), RLSE) , 

/ / DCB= (RECFM=FB , LRECL=80 , BLKSIZE=7200 ) 

/ /GO.FT19F001 DD UNIT=SYSDA, DISP=( , PASS ), SPACE- (TRK, (2, 1 ), RLSE) , 

/ / DCB= (RECFM=FB , LRECL=80 , BLKSIZE-7200 ) 

/ /GO.FT20F001 DD UNIT=SYSDA,DISP=( , PASS) , SPACE=(TRK, (2,1) ,RLSE) , 

/ / DCB= ( RECFM=FB , LRECL=80 , BLKSIZE-7200 ) 

II* 

II* INPUT MAGNETIC FIELD DATA SET FOLLOWS 
II* ( THIS IS THE FIELD OUTPUT FROM STEP3 ) 

II GO.FT21F001 DD DSN=XRSHS .MAY684 . STEP3 . COEFFS ,DISP=SHR 

II* 

II* INPUT TREND-FIT DATA SET FOLLOWS 

II* 

II GO.FT22F001 DD DSN=XRTJS . BSPINFO .DATA, DISP=SHR 

II* 

II* SYSTEM DUMP FOR ABEND-AID FOLLOWS 

II* 

//GO.SYSUDUMP DD DUMMY 
II EXEC NOTIFYTS 
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B. For STAGE 2 there are two deck setups, one using the load module and one 
using the source code. 

Note that for Unit 10 the tape is a dummy. The additional "information" is 
irrelevant to this run, but might be useful in other applications. These 
setups include an input set of SHA coefficients as a starting model for FIT 
and a list of observatories and their biases as determined in an earlier 
FIT. The basic program is the old FIT program. 
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STAGE 2 Run Deck with load module 


//X RJRRTS2 JOB (G0111 ,X22, 20) ,EUTST, TIME=( 7 , 00) ,NOTIFY=XRJRR,CLASS=0, 

II MSGCLASS=X 
/ *JOBPARM LINES=15 

II* 

I l*X RJRR.DTAPE. PROCESS (STEP2) — USE OF A LOAD MODULE ( FIT . DMSP . LOAD2 ) 
II* INPUT TO THIS STEP IS FILE "OUTBIN" ON UNIT/17, FROM STEP1. 

II* INPUT IS ON UNIT #19. 

II* THE JOB SETUP PARAMETERS ARE ON UNIT #5. 

II GO EXEC PGM=FIT , REGION=3000K 

II STEPLIB DD DISP=SHR,DSN=XRJRR. FIT. DMSP. L0AD2 

II GO.FTOlFOOl DD UNIT=SYSDA, SPACE=(CYL, (7,2) , RLSE) , 

/ / DCB= (RECFM=VBST , LRECL=200 , BLKSIZE=12004 ) 

/ /GO . FT02F001 DD UNIT=SYSDA, SPACE= (CYL , ( 7 , 2 ) , RLSE) , 

/ / DCB* (RECFM=VBST , LRECL=200 , BLKSIZE=12004 ) 

/ /GO.FT06F001 DD SYSOUT=* 

/ /GO.FT07F001 DD DUMMY, SYS0UT=B,DCB=(RECFM=FB,LRECL=80,BLKSIZE=7280) , 

II SPACE=(CYL, (0,1) .RLSE) 

/ /GO . FT10F001 DD DUMMY , DSN=POG6CQ , UNIT= ( 9TRACK, .DEFER) ,DISP=( OLD, KEEP) , 
II DCB= (RECFM=VBS , LRECL=4004 , BLKSIZE=4008 ) , LABEL= ( 1 , SL , ,IN) , 

II VOL=SER=MAG001 

/ /GO.FT10F002 DD DUMMY , DSN=POG6MQ , UNIT= ( 9TRACK, .DEFER) ,DISP=( OLD, KEEP) , 
II DCB=(RECFM=VBS , LRECL=4004 , BLKSIZE-4008 ) , LABEL=(2, SL, , IN) , 

II VOL=SER=MAGO 0 1 

/ /GO.FT10F003 DD DUMMY , DSN=POG246 , UNIT= ( 9TRACK, .DEFER) ,DISP=( OLD, KEEP) , 
II DCB= (RECFM=VBS , LRECL=4004 , BLKSIZE=4008 ) , LABEL- ( 3 , SL , ,IN) , 

II VOL=SER=MAG001 

II* 

II* UNIT 11 IS A NORMAL MATRIX FILE. THIS IS NEEDED IN STEP 2 
II* ONLY IF STATISTICS ON THE INPUT DATA ARE DESIRED. 

II FT11F001 DD DSN= ’ XRJRR . FIT . OUT . NMATX ’ , DISP=SHR 

II* 

II* UNIT 12 IS A SCRATCH FILE. 

/ /FT12F001 DD UNIT=SYSDA,DISP=( , PASS ) , SPACE=(TRK, (90, 20) .RLSE) , 

/ / DCB= (RECFM=VBS , LRECL=100 , BLKSIZE=7204 ) 

/ /GO.FT13F001 DD DUMMY 
/ /FT15F001 DD DUMMY 
II FT16F001 DD DUMMY 
II FT17F001 DD DUMMY 
II FT18F001 DD DUMMY 

II* 

II* BINARY INPUT DATA FOLLOWS. MUST BE IN FIT BINARY FORMAT. 

//* T19F001 DD DSN-XRJRR.EUTEST .MAR1984 . STEP1,DISP=SHR 
/ /FT19F001 DD DSN=XRJRR.MAR1984 . STEP1 .OUTBIN, DISP=SHR 

II* 

II FT22F001 DD UNIT=SYSDA,DISP=( , PASS) , SPACE=(TRK, (40, 10) .RLSE) , 

/ / DCB= (RECFM-FB , LRECL=80 , BLKSIZE=7200 ) 

II FT23F001 DD UNIT=SYSDA,DISP=( .PASS) ,SPACE=(TRK, (40,10) .RLSE) , 

/ / DCB= (RECFM=FB , LRECL=80 , BLKSIZE=7200 ) 

II FT24F001 DD UNIT=SYSDA, DISP=( , PASS ) , SPACE= (TRK, (40 , 10) , RLSE) , 

/ / DCB=(RECFM=FB , LRECL=80 , BLKSIZE=7200 ) 

II* 
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//* OUTPUT COEFFICIENTS FOLLOW. 

/ /FT25F001 DD DSN=XRJRR.FIT.DMSP.COEFFS,UNIT=SYSDA,DISP=SHR 
/ / *VOL=SER=SACC09 , DCB= (RECFM=FB , LRECL=80 , BLKSIZE=8000 ) , 

//* SPACE=(TRK, (2,2) ,RLSE) ,DISP=(NEW,CATLG) 

II * 

/ /FT35F001 DD DUMMY 
/ /FT36F001 DD DUMMY 
II FT40F001 DD DUMMY 
II FT45F001 DD DUMMY 
II SYSUDUMP DD DUMMY 
II FT05F001 DD * 

&CONTRL NSIML=0 , IRSTRT=0,NOISE=0,RTIM=9999. , 


EULER=2 , IBIAS=1 , 

ITER=2, 

NSKIP=1 , 

SEND 

MARCH 19-21, 1984 , TEST OF DMSP EULER ANGLE SOLUTION. 
& FIELD MONO=2 , 

NMAXR=0 , NMAXTR=0 , 

BGNTIM=0 . , 

EXTFLD=0 , NEXT=0 
PRCORL=4 , 

IDST=0 , 

EPOCH=1984 . 22 , AVETIM=1984 . 22, 

NMAX=11 , NMAXT=9 , NMAXTT=0 , NMXTTT=0 , NMAXIV=0 , NMAXV=0 , 


&END 

S.LIMERR ERRLIM=2*20 . , 8*1000 . , 
NTDATA=1 , NAT ( 1 ) =8 , NAT ( 2 ) =2 , APRIOR=0 , 
NSTOP=0 , 

AYSTAT=1, BIASAP=5000 . , 


NDGEN=5 , &END 


2 

1-29878.2 

0. OOOOOOE+OO 

26.9879 

2 

2-1924.05 

5526.55 

7.95582 

3 

1-2063.34 

0. OOOOOOE+OO 

-16.6929 

3 

2 3044.32 

-2183.87 

4.24784 

3 

3 1682.87 

-291.646 

5.04403 

4 

1 1279.34 

0. OOOOOOE+OO 

- ! 558737 

4 

2-2200.81 

-317.451 

-5.07226 

4 

3 1250.13 

282.905 

-.185285 

4 

4 831.335 

-289.166 

-.373123 

5 

1 943.053 

0. OOOOOOE+OO 

1.34613 

5 

2 776.331 

230.858 

-1.48226 

5 

3 370.782 

-248.342 

-6.77951 

5 

4-424.398 

64.1152 

-1.36512 

5 

5 174.567 

-294.299 

-6.07800 

6 

1-211.934 

0. OOOOOOE+OO 

1.48473 

6 

2 358.879 

45.6865 

0.409051 

6 

3 252.241 

145.820 

-2.20934 

6 

4-90.4987 

-152.384 

-4.06068 

6 

5-162.388 

-77.5140 

-.119331 

6 

6-48.5517 

97.0991 

-.127636 

7 

1 50.2750 

0. OOOOOOE+OOO. 582770 

7 

2 65.8066 

-14.4218 

0 . 735771E 


3*1000. ,2*. 0012, 2*30. , 


0 . 000000E+000 . 000000E+000 . 000000E+00 
-19.3154 0.000000E+000 .000000E+00 

0 . 000000E+000 . OOOOOOE+OOO . 000000E+00 
-13.6396 0. OOOOOOE+OOO. 000000E+00 

-22.9796 0. OOOOOOE+OOO. 000000E+00 

0. OOOOOOE+OOO. OOOOOOE+OOO. 000000E+00 
4.55282 0. OOOOOOE+OOO. 000000E+00 

3.00112 0. OOOOOOE+OOO. 000000E+00 

-9.23767 0. OOOOOOE+OOO. 000000E+00 

0 . OOOOOOE+OOO . OOOOOOE+OOO . 000000E+00 
4.66531 0. OOOOOOE+OOO. 000000E+00 

2.08782 0. OOOOOOE+OOO. 000000E+00 

2.80991 0. OOOOOOE+OOO. 000000E+00 

0.717217 0. OOOOOOE+OOO. 000000E+00 

0. OOOOOOE+OOO. OOOOOOE+OOO . OOOOOOE+OO 
-.126245 0. OOOOOOE+OOO. OOOOOOE+OO 

- .996403 0. OOOOOOE+OOO . OOOOOOE+OO 

-.441015 0. OOOOOOE+OOO. OOOOOOE+OO 

0.529454E-010. OOOOOOE+OOO. OOOOOOE+OO 
1.24753 0. OOOOOOE+OOO. OOOOOOE+OO 

0. OOOOOOE+OOO. OOOOOOE+OOO. OOOOOOE+OO 
010. 834850E-010. OOOOOOE+OOO. OOOOOOE+OO 
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7 3 48.4155 88.5492 1.62415 -1.12290 0 . 000000E+000 . 000000E+00 

7 4-186.477 71.0999 1.40833 0.130572 0 . OOOOOOE+OOO . 000000E+00 

7 5 1.98577 -47.6321 -.400328 -1.14035 0 . OOOOOOE+OOO . OOOOOOE+OO 

7 6 15.7450 -2.92768 0.481683 -.177513 0 . OOOOOOE+OOO . OOOOOOE+OO 

7 7-103.694 20.6672 1.00832 0.861644 0 . OOOOOOE+OOO . OOOOOOE+OO 

8 1 75.1637 0. OOOOOOE+OOO. 801818 0 . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OO 

8 2-62.4921 -83.4985 -.823360 -.239219 0 . OOOOOOE+OOO . OOOOOOE+OO 

8 3 2.80617 -24.7745 0.344860 0.661025 0 . OOOOOOE+OOO . OOOOOOE+OO 

8 4 23.7248 -4.34651 0.746856 0.200311 0 . OOOOOOE+OOO . OOOOOOE+OO 

8 5-4.97948 20.8105 1.86428 1.13190 0 . OOOOOOE+OOO . OOOOOOE+OO 

8 6 1.19654 21.6843 0.140686 0.974664 0 . OOOOOOE+OOO . OOOOOOE+OO 

8 7 10.5049 -23.1920 -. 207177E-01- . 463253E-010 . OOOOOOE+OOO . OOOOOOE+OO 

8 8-2.16799 -5.21783 -.121684 1.11800 0 . OOOOOOE+OOO . OOOOOOE+OO 

9 1 20.3340 0. OOOOOOE+OOO. 462131 0 . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OO 

9 2 5.24161 6.06898 -.324161 -.183895 0 . OOOOOOE+OOO . OOOOOOE+OO 

9 3 1.01194 -18.4504 0.363677 -.236736 0 . OOOOOOE+OOO . OOOOOOE+OO 

9 4-9.58137 6.24225 0.352333 0.509160 0 . OOOOOOE+OOO . OOOOOOE+OO 

9 5-10.2597 -23.2842 -.831963 -.270271 0 . OOOOOOE+OOO . OOOOOOE+OO 

9 6 3.37727 6.95803 -.212720 -.542091 0 . OOOOOOE+OOO . OOOOOOE+OO 

9 7 3.81301 14.4615 0.274855 -.405454 0 . OOOOOOE+OOO . OOOOOOE+OO 

9 8 4.60530 -15.2854 -.353735 -.520160 0 . OOOOOOE+OOO . OOOOOOE+OO 

9 9-2.70855 -11.8510 -.332573 0.677450 0 . OOOOOOE+OOO . OOOOOOE+OO 

10 1 5.44687 0. OOOOOOE+OOO. OOOOOOE+OOO. OOOOOOE+OOO. OOOOOOE+OOO. OOOOOOE+OO 

10 2 10.3427 -20.8446 0 . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OO 

10 3 1.53718 15.3630 0 . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OO 

10 4-12 . 3475 8 . 96920 0 . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OO 

10 5 9.43396 -5.32006 0 . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OO 

10 6-3 . 42227 -6.34494 0 . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OO 

10 7-1.19068 8.99323 0 . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OO 

10 8 6.68696 9.64659 0 . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OO 

10 9 1.51691 -5.95444 0 . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OO 

10 10-5,00116 1.95644 0 . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OO 

11 1-3.43391 0. OOOOOOE+OOO. OOOOOOE+OOO. OOOOOOE+OOO. OOOOOOE+OOO. OOOOOOE+OO 

11 2-3 . 99290 1 . 28190 0 . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OO 

11 3 2.22121 0.472492 0 . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OO 

11 4-5.42399 2.66175 0 . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OO 

11 5-1.98615 5.76969 0 . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OO 

11 64. 57595 -4.23475 0 . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OO 

11 7 3.15891 -.422710 0 . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OO 

11 80.908603 -1.35638 0 . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OO 

11 9 1.98001 3.56776 0 . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OO 

11 10 2.79926 -.462133 0 . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OO 

11 11- .274364 -6.13455 0 . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OOO . OOOOOOE+OO 

0 0 
0 

&EUORBS Y1=0 .DO , Z1=0 .DO , Z2=0 . DO , 

EUD ( 1 , 1 ) =0 . DO f EUD ( 2 , 1 ) =0 . DO , EUD ( 3 1 1 ) =0 . DO , 

EUD ( 1 # 2 ) =0 . DO , EUD ( 2 , 2 ) =0 . DO , EUD ( 3 , 2 ) =0 . DO f 
BS1=0 . DO , BS2=0 . DO , BS3=0 . DO , 

BST1=0 . DO , BST2=0 . DO , BST3=0 . DO , 

& END 
0 
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&TAPENO ITAPE=1 , IFILE=1 , IMODE=I , ISELEC=0 , DLATLM=75 . DO , 

TIMI=I979 • , TIM2=I999. ,VECLIM=90. , THETAO=II . 12, PHI0=289 .2, &END 
1 1, 1* 1. I • 1* X* X. X. X . X* X* X* x • 

X 

6 

0 


1960.0 X999 . 0 

ABINGER 
ABISKO 
ADAK 

ADDIS ABABA 

AGINCOURT 

ALERT 

ALIBAG 

ALIBAG II 

ALMA ATA 

ALMERIA 

AMBERLEY II 

ANCHORAGE 

ANNAMALAINAGAR 

APIA III 

AQUILA 

ARGENTINE ISLND 

ART I 

ASO 

AVERROES 

BAKER LAKE 

BANGUI 

BANGUI II 

BANGUI III 

BARROW II 

BARROW III 

BARTER ISLAND 

BEIJING 

BELOIT 

BELSK 

BEREZNAYKI 

BIG DELTA 

BINZA 

BJORNOYA 

BOULDER 

BUDAKESZI 

BUDKOV 

BURLINGTON 

BYRD II 

CAMBRIDGE BAY 

CANBERRA 

CARROLLTON 

CASEY 

CASPER 

CASTELLACCIO 

CASTLE ROCK 

CHA PA 


0.80 

0.44 

‘ 0 . 16 

X • 22 

X . 37 

2.06 

5.92 

2.05 

8 . 17 

3.26 

5. XX 

3 . 15 

2.52 

2.08 

5.08 

5.24 

8 . 18 

19 . 86 

7 . 16 

2.47 

6.23 

X . 17 

0.96 

X . 18 

3 • 16 

3.05 

2.76 

3.37 

X . 48 

2 . 91 

2.60 

0.96 

2.90 

9999.00 

9999.00 

9999.00 

7 . 13 

7.74 

XO . 89 

3.53 

X . 66 

2:27 

2.42 

X . 23 

X . 92 

3.98 

X . 39 

2 . 61 

2.63 

X . 12 

3.36 

9999.00 

9999.00 

9999.00 

9999.00 

9999.00 

9999.00 

3 . 13 

3.28 

4.44 

XO .96 

4.67 

4.06 

0.47 

4.88 

X . 82 

6.46 

5.64 

3.32 

5.03 

3.04 

27.69 

3.06 

2 . 81 

6.57 

9999.00 

9999.00 

9999.00 

4.25 

X . 86 

3.35 

9999.00 

9999.00 

9999.00 

2 . 14 

X . 73 

X . 93 

2.34 

5.63 

4.87 

9999.00 

9999.00 

9999.00 

6 . 19 

4.99 

2.95 

2. OX 

3.52 

4 .16 

2.53 

X . 45 

X . 93 

9999.00 

9999.00 

9999.00 

X . 92 

0.88 

X . 67 

9999.00 

9999.00 

9999.00 

4.00 

X . 95 

7.55 

3 . 18 

2.05 

2.89 

0.62 

2.85 

X . 64 

9999.00 

9999.00 

9999.00 

48.80 

0.82 

53.70 

9999.00 

9999.00 

9999.00 

X . 93 

0.64 

6.00 

5.87 

4.57 

4.37 

5.96 

3.54 

7.86 
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CHAMBON FORET 

2.96 

1.38 

4.96 

CHANGCHUN 

9999.00 

9999.00 

9999.00 

CHELTENHAM 

9999.00 

9999.00 

9999.00 

CHELYUSKIN II 

2.23 

2.03 

7.54 

COIMBRA 

2.91 

1.35 

2.26 

COLLEGE 

2.89 

1.59 

3.87 

COSTA RICA 

9999.00 

9999.00 

9999.00 

DALLAS 

2.45 

1.03 

1.95 

DAVIS 

9999.00 

9999.00 

9999.00 

DIKSON II 

4.30 

2.79 

9.86 

DOMBAS II 

2.57 

1.53 

1.84 

DOURBES 

1.81 

1.11 

2.27 

DRUZHNAYA 

5.40 

5.56 

15.94 

DUMONT DURVILLE 

4.85 

4.75 

14.95 

DUSHETI 

4.23 

1.92 

4.69 

DYMER 

1.76 

1.08 

2.05 

EBRO 

3.16 

1.49 

1.99 

EIGHTS 

4.19 

0.42 

4.33 

ELISABETHVILLE 

2.31 

1.15 

3.06 

ESKDALEMUIR 

1.96 

1.23 

2.60 

ESPANOLA 

9999.00 

9999.00 

9999.00 

EYREWELL 

9999.00 

9999.00 

9999.00 

FANNING ISLAND 

9999.00 

9999.00 

9999.00 

FORT CHURCHILL 

3.67 

2.72 

3.93 

FORT YUKON 

9999.00 

9999.00 

9999.00 

FREDERICKSBURG 

3.21 

1.08 

2.90 

FUQUENE 

2.46 

2.25 

7.60 

FURSTNFELDBRUCK 

2.39 

0.96 

2.09 

GIBILMANNA 

9999.00 

9999.00 

9999.00 

GNANGARA 

2.05 

1.01 

2.07 

GODHAVN 

1.86 

1.49 

4.21 

GONZALEZ VIDELA 

9999.00 

9999.00 

9999.00 

GORNOTAYEZHNAYA 

3.21 

1.25 

5.64 

GREAT WHALE R 

6.43 

2.01 

4.20 

GROCKA 

2.27 

0.83 

2.40 

GUAM 

3.65 

1.24 

2.16 

GUANGZHOU 

9999.00 

9999.00 

9999.00 

HALLETT STATION 

11.86 

20.93 

109.30 

HALLEY BAY 

9.35 

27.52 

31.37 

HARTEBEESTHOEK 

9999.00 

9999.00 

9999.00 

HARTLAND 

1.95 

0.93 

1.95 

HATIZYO 

9999.00 

9999.00 

9999.00 

HAVANA 

2.23 

1.57 

4.43 

HEALY 

9999.00 

9999.00 

9999.00 

HEL 

2.00 

1.61 

2.28 

HELWAN 

0.45 

2.41 

2.19 

HERMANUS 

2.90 

1.24 

1.32 

HOLLAND IA 

5.51 

2.49 

7.33 

HONGKONG 

25.75 

9.58 

8.04 

HONOLULU IV 

3.40 

0.82 

1.46 

HUANCAYO 

3.61 

1.54 

2.20 

HURBANOVO 

2.89 

1.06 

2.98 

HYDERABAD 

3.98 

14.84 

2.58 
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IBADAN 

I SLA DE PASCUA 
ISTANBL KNDILLI 
JAIPUR 

JARVIS ISLAND 
JASSY 

JULIANEHAAB II 

KAKIOKA 

KANOYA 

KANO Z AN 

KELES 

KERGUELEN 

KIEV 

KLYUCHI 

KODAIKANAL 

KOROR 

KOTZEBUE 

KRASNAYA PAKHRA 

KSARA 

L AMERICA III 
L AMERICA V 
LA PAZ 

LA QUIACA II 

LANZHOU 

LAUDER 

LAZAREVA 

LEADVILLE 

LEIRVOGUR 

LERWICK 

LHASA 

LOGRONO 

LOPARSKOYE 

LOVO 

LUANDA BELAS 
LUNPING 
LVOV 
LWIRO 
M BOUR 

MACQUARIE ISLND 

MAGADAN 

MAJURO 

MANHAY 

MAPUTO 

MARION ISLAND 

MARTIN VIVIES 

MAURITIUS II 

MAWSON 

MEANOOK 

MEMAMBETSU 

MIDWAY 

MIRNYY 

MISALLAT 

MOCA 


3.68 6.56 1.92 

9999.00 9999.00 9999.00 
2.07 1.47 4.34 

9.67 0.61 23.81 

9999.00 9999.00 9999.00 
9999.00 9999.00 9999.00 


15 . 

00 

3 . 

46 

3 . 

44 

3 . 

94 

3 . 

07 

3 . 

36 

6 . 

72 

3 . 

22 

5 . 

09 

15 . 

00 

9999 . 

00 

1 . 

84 

6 . 

68 

9999 . 

00 

9999 . 

00 

3 . 

80 

4 . 

87 

9999 . 

00 

9999 . 

00 

9999 . 

00 

9999 . 

,00 

2 . 

,82 

1 , 

,79 

5 . 

.53 

2 , 

.64 

2 < 

.37 

1 , 

.93 

6 , 

.44 

3 

.37 

3 

.07 

6 

.12 

3 

.17 

3 

.03 

1 

.63 

0 

.89 

3 

.54 

4 

.15 

5 

.96 

9999 

.00 

8 

.38 

3 

.30 

3 

.74 

3 

.46 

9999 

.00 

5 

.10 

3 

.68 

3 

.22 


15.00 

1.47 
0.78 
1.34 
0.71 
2.81 
3.56 
0.83 

5.08 
15.00 

9999.00 

1.33 

1.83 

9999.00 

9999.00 

1.77 

1.69 

9999.00 

9999.00 

9999.00 

9999.00 

1.43 

1.38 
2.18 

2.48 
2.19 
1.03 
2.74 
1.85 
1.02 
1.79 

4.87 

5.87 

1.08 
7.10 
4.62 
3.33 
0.99 

9999.00 

4.52 

4.36 

2.30 

0.76 

9999.00 

4.38 
2.24 
2.65 


15.00 

3.42 

1.20 

2.36 

4.35 

2.65 

2.44 

2.74 

4.30 

15.00 

9999.00 

2.84 

19.61 

9999.00 

9999.00 

12.02 

2.39 

9999.00 

9999.00 

9999.00 

9999.00 

3.73 

2.05 

4.19 

2.01 

5.10 

2.10 

10.29 

2.44 

4.37 

2.14 

1.91 

4.65 

30.43 

1.10 

6.27 

4.11 

1.91 
9999.00 

13.17 

7.49 

6.57 

2.81 

9999.00 

11.53 

3.91 

1.68 
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MODIIM 

9999.00 

9999.00 

9999.00 

MOLODEZHNAYA 

7.51 

7.79 

22.67 

MONTE CAPELLINO 

6.27 

6.29 

7.48 

MOULD BAY 

2.35 

2.61 

3.66 

MUNTINLUPA 

4.33 

3.51 

3.78 

NAGYCENK 

3.65 

2.38 

3.53 

NAIROBI 

3.77 

2.88 

6.36 

NANTES 

3.25 

1.77 

4.59 

NEWPORT 

2.16 

1.17 

2.08 

NIEMEGK 

2.18 

0.99 

2.25 

NITZANIM 

9999.00 

9999.00 

9999.00 

NORTHWAY 

9999.00 

9999.00 

9999.00 

NORWAY STATION 

9999.00 

9999.00 

9999.00 

NOVO KAZALINSK 

6.13 

21.64 

5.21 

NOVOLAZAREVSKAY 

3.49 

4.57 

16.75 

NURMIJARVI 

2.71 

1.53 

2.52 

OASIS 

9999.00 

9999.00 

9999.00 

ORCADAS DEL SUR 

9999.00 

9999.00 

9999.00 

PAMATAI 

5.17 

1.34 

3.72 

PAMATAI II 

3.97 

1.34 

1.98 

PANAGYURISHTE 

2.63 

0.84 

2.50 

PARAMARIBO 

3.79 

1.61 

2.78 

PATRICK 

9999.00 

9999.00 

9999.00 

PATRONY 

2.78 

1.43 

3.11 

PENDELI 

9999.00 

9999.00 

9999.00 

PILAR 

4.78 

1.59 

3.44 

PIONERSKAYA 

9999.00 

9999.00 

9999.00 

PLAISANCE 

9999.00 

9999.00 

9999.00 

PLATEAU 

0.12 

8.02 

15.78 

PLESHENITZI 

2.31 

4.38 

2.49 

PORT MORESBY 

2.21 

1.60 

4.58 

PORT -ALFRED 

2.22 

1.57 

2.67 

PRICE 

9999.00 

9999.00 

9999.00 

PRUHONICE 

3.06 

1.02 

3.71 

QUETTA 

5.78 

7.06 

6.51 

REGENSBERG 

2.73 

1.86 

3.19 

RESOLUTE BAY 

2.20 

2.18 

6.76 

ROBURENT 

4.04 

22.09 

6.98 

ROI BAUDOUIN 

0.67 

1.86 

1.70 

RUDE SKOV 

2.14 

1.14 

2.36 

SABHAWALA 

8.85 

5.99 

9.82 

SAN FERNANDO 

3.70 

3.36 

17.15 

SAN JOSE LAS LA 

14.56 

2.82 

101.03 

SAN JUAN 

3.84 

1.30 

3.16 

SAN JUAN II 

3.05 

0.89 

3.27 

SAN MIGUEL III 

5.24 

14.55 

3.29 

SANAE 

4.64 

13.43 

7.17 

SCOTT BASE 

8.25 

4.81 

18.79 

SHESHAN 

3.22 

2.34 

2.45 

SHILLONG 

4.68 

2.38 

0.71 

SIMFEROPOL 

9999.00 

9999.00 

9999.00 

SIMOSATO 

3.56 

1.47 

1.91 

SITKA 

2.24 

1.31 

2.24 
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SODANKYLA 

SOUTH GEORGIA 

SOUTH POLE 

SREDNIKAN IV 

STEKOLINIY 

STEPANOVKA 

STONYHURST 

SURLARI 

SWIDER 

SYOWA BASE 

TAHITI 

TAMANRASSET 

TANANARIVE 

TANGERANG 

TATUOCA 

TEHRAN 

TEHRAN II 

TENERIFE 

TEOLOYUCAN 

THULE II 

TIHANY 

TIKHAYA BAY 

TIKSI 

TOLEDO 

TOMSK 

TOOLANGI 

TRELEW 

TRIVANDRUM 

TROMSO 

TSUMEB 

TUCSON 

TULSA 

UELEN 

UJJAIN 

ULAN BATOR 

URUMQI 

VALENTIA 

VANNOVSKAYA 

VASSOURAS 

VICTORIA 

VOROSHILOV 

VOSTOK 

VOYEYKOVO 

VYKHODNOY 

VYSOKAY DUBRAVA 

WATHEROO 

WIEN KOBENZL 

WILKES 

WINGST 

WITTEVEEN 

WUHAN 


2.83 

1.31 

2.88 

4.57 

3.17 

2.57 

5.00 

5.06 

11.67 

6.37 

2.49 

13.26 

2.74 

1.76 

2.36 

2.69 

1.10 

3.29 

3.19 

9.57 

2.83 

8.88 

2.44 

18.22 

2.39 

0.97 

7.13 

3.13 

8.86 

11.35 

9999.00 

9999.00 

9999.00 

6.62 

9.97 

14.19 

4.79 

2.97 

7.43 

26.70 

14.07 

43.78 

5.15 

2.33 

5.57 

4.92 

3.50 

7.66 

9999.00 

9999.00 

9999.00 

9.17 

10.70 

14.67 

16.56 

11.22 

20.84 

1.43 

0.87 

4.68 

4.45 

2.07 

4.57 

0.97 

1.43 

0.47 

4.97 

1.35 

9.00 

3.17 

1.19 

5.87 

4.22 

1.81 

6.39 

1.58 

1.30 

1.67 

3.37 

2.76 

2.25 

5.51 

7.37 

5.38 

3.97 

1.76 

5.17 

2.82 

1.19 

1.64 

2.89 

0.94 

2.27 

9999.00 

9999.00 

9999.00 

4.75 

10.61 

5.52 

12.76 

3.68 

7.07 

11.40 

1.92 

2.89 

9999.00 

9999.00 

9999.00 

2.06 

0.92 

1.62 

4.42 

2.79 

6.00 

4.20 

1.68 

2.57 

3.02 

1.57 

2.87 

5.21 

0.27 

0.0 

11.89 

8.99 

14.45 

2.54 

1.19 

3.25 

9999.00 

9999.00 

9999.00 

2.37 

0.94 

5.94 

3.63 

1.56 

7.82 

2.29 

0.93 

1.97 

5.37 

3.33 

11.61 

1.75 

0.80 

2.38 

3.66 

1.00 

2.24 

9999.00 

9999.00 

9999.00 
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YAKUTSK 

3.93 

2.34 

5.80 

YANGI- BAZAR 

3.11 

0.97 

3.32 

YELLOW-KNIFE 

2.74 

3.15 

5.39 

YUZHNO SAKHALSK 

3.13 

1.46 

1.18 

YUZHNO SAKH II 

3.89 

2.35 

4.28 

YUZHNO SAK III 

5.45 

6.38 

2.87 

ZAYMISHCHE 

3.49 

1.02 

4.41 

ZUY 

4.07 

0.87 

2.54 


II EXEC NOTIFYTS 
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STAGE 2 Run Deck with source deck 


/ /X RJRRXYZ JOB (F8002.X22, 50) , STEP2B , TIME= (6,0) , NOTIFY=XRJRR, CLASS=0 , 

II MSGCLASS=X 

/*JOBPARM LINES=60 

II* XRJRR.DTAPE . PROCESS (STEP2B) 

II* TEST FOR EULER ANGLE, BIAS SOLUTION. MARCH 19-21, 1984 
/ / EXEC SYS IN 

II SYSIN DD DSN=XRJRR . FIT . FILES (UPDMSP2 ) , DISP=SHR 

II TPSY EXEC PGM=TPSYS,REGION=150K 

II STEPLIB DD DSN=YCWDW. TPSYS .LOAD, DISP=SHR 

II FT10F001 DD DSN=YCDMM. FIT. FORT, UNIT=SYSDA,DISP=SHR 

II FT11F001 DD UNIT=SYSDA,DSN=YCDMM.FIT . SRCE, SPACE=(CYL, (5,1), RLSE) , 

/ / DCB=(RECFM=FB,LRECL=80,BLKSIZE=7280) ,DISP=( , PASS) 

/ /FT06F001 DD SYSOUT=* 

/ /FT05F001 DD DISP=SHR, DSN=&&DATA5 

1 1 EXEC OFORTH , PARM= ’ XREF , LINECNT=60 ’ , REGI0N=2000K 
//SYSIN DD DISP=(OLD, DELETE) ,DSN=YCDMM. FIT. SRCE 
//RESULT EXEC OLINKH , COND= ( 9 , LT ) 

II NEWLIN DD DSN=YCWDW. FITQ . LOAD , DISP=SHR 
/ / SYSLMOD DD DSN=YCDMM. FTT. LOAD, DISP=( .PASS) 

II OBJECT DD * 

INCLUDE NEWLIN (FIT8305) 

ENTRY MAIN 
NAME FIT (R) 

//REALY EXEC PGM=FIT , REGION=3000K 

//STEPLIB DD DISP=SHR,DSN=YCDMM. FTT. LOAD 

/ /GO .FT01F001 DD UNIT=SYSDA, SPACE= (CYL , (7 , 2) ,RLSE) , 

/ / DCB= (RECFM=VBST , LRECL=200 , BLKSIZE=12004 ) 

II GO.FT02F001 DD UNIT=SYSDA, SPACE=(CYL, (7 , 2) .RLSE) , 

/ / DCB=(RECFM=VBST , LRECL=200 , BLKSIZE=12004) 

II GO.FT06F001 DD SYSOUT=* 

/ /GO.FT07F001 DD DUMMY, SYSOUT=B , DCB= (RECFM=FB , LRECL=80 , BLKSIZE=7280 ) , 

II SPACE=(CYL, (0,1) , RLSE) 

/ /GO.FTlOFOOl DD DUMMY , DSN=POG6CQ , UNIT= ( 9TRACK, .DEFER) ,DISP=( OLD, KEEP) , 
/ / DCB= (RECFM=VBS , LRECL=4004 , BLKSIZE=4008 ) , LABEL= ( 1 , SL , ,IN) , 

II VOL=SER=MAG001 

1 1 GO.FT10F002 DD DUMMY, DSN=POG6MQ , UNIT= ( 9TRACK, .DEFER) ,DISP=( OLD, KEEP) , 
/ / DCB= (RECFM=VBS , LRECL=4004 , BLKSIZE=4008 ) , LABEL= ( 2 , SL , .IN) , 

II VOL=SER=MAG001 

/ /GO . FT10F003 DD DUMMY , DSN=P0G246 , UNIT= ( 9TRACK, .DEFER) ,DISP=( OLD, KEEP) , 
II DCB= (RECFM=VBS ,LRECL=4004 , BLKSIZE=4008 ) , LABEL=( 3 , SL, ,IN) , 

II VOL=SER=MAG001 

II FT11F001 DD DSN=’XRJRR.FIT.OUT .NMATX’ ,DISP=SHR 

II FT12F001 DD UNIT=SYSDA, DISP= ( , PASS ) , SPACE=(TRK, ( 90 , 20) , RLSE ) , 

/ / DCB= (RECFM=VBS , LRECL=100 , BLKSIZE=7204 ) 

I /GO.FT13F001 DD DUMMY 
/ /FT15F001 DD DUMMY 
II FT16F001 DD DUMMY 
/ /FT17F001 DD DUMMY 
/ /FT18F001 DD DUMMY 

II* 
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//* BINARY INPUT DATA FOLLOWS. 

/ /FT20F001 DD DSN=XRJRR .MARI 984 . STEP1 .OUTBIN,DISP=SHR 

II* 

II FT22F001 DD UNIT=SYSDA,DISP=( .PASS) ,SPACE=(TRK, (40,10) ,RLSE) , 

/ / DCB*= ( RECFM=FB , LRECL=80 , BLKSIZE=7200 ) 

II FT23F001 DD UNIT=SYSDA,DISP=( .PASS) , SPACE=(TRK, (40,10) ,RLSE) , 

/ / DCB= (RECFM=FB , LRECL=80 , BLKSIZE=7200 ) 

II FT24F001' DD UNIT=SYSDA,DISP=( ,'PASS) , SPACE=(TRK, (40,10) ,RLSE) , 

/ / DCB=(RECFM=FB , LRECL=80 , BLKSIZE=7200 ) 

II* 

II* OUTPUT COEFFICIENTS FOLLOW. 

/ /FT25F001 DD DUMMY , DSN=XRJRR . FIT . DMSP . COEFFS , UNIT=SYSDA, DISP=SHR 
/ / *VOL=SER=SACC09 , DCB= (RECFM=FB , LRECL=80 , BLKSIZE=8000 ) , 

/ /*SPACE=(TRK, (2,2) ,RLSE) , DISP= (NEW, CATLG) 

II* 

II FT35F001 DD DUMMY 
II FT36F001 DD DUMMY 
II FT40F001 DD DUMMY 
/ /FT41F001 DD DUMMY 
II FT45F001 DD DUMMY 
I /FT46F001 DD DUMMY 
II FT65F001 DD DUMMY 
//SYSUDUMP DD DUMMY 
II FT05F001 DD * 

ScCONTRL NSIML=0, IRSTRT=0,NOISE=0,RTIM=9999. , 

EULER=2 , IBIAS=1 , 

ITER=2 , 

NSKIP=1 , 

& END 

DMSP MAR19-21, 1984 SOLVE FOR EU ANGLES, BIASES. LAT CUT=75, DEGREE=4 . 

ScFIELD M0N0=2 , 

NMAXR=0 , NMAXTR=0 , 

BGNTIM=0 . , 

EXTFLD=0 , NEXT=0 
PRCORL=4 , 

IDST=0, 

EPOCH=1984 . 22, AVETIM=1984 . 22 , 

NMAX=11 , NMAXT=9 , NMAXTT=0 , NMXTTT=0 , NMAXIV-0 , NMAXV=0 , 

ScEND 

ScLIMERR ERRLIM=2*90. ,8*1000. , 3*1000. ,2*. 0012, 2*30. , 

NTDATA=1 , NAT ( 1 ) =8 , NAT ( 2 ) =2 , APRI0R=0 , 

NSTOP=0 , 

AYSTAT=1 , BIASAP=5000 . , 

NDGEN=5 , ScEND 

2 1-29878.2 0.000000E+00 26.9879 0 . OOOOOOE+OOO . 000000E+000 . 000000E+00 

2 2-1924.05 5526.55 7.95582 -19.3154 0 . OOOOOOE+OOO . 000000E+00 
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C. STAGE 3 is a simple program to change the format of the SHA 
coefficients . 

Run Deck for STAGE 3 

/ /XRJRRST3 JOB (F8002.X22, 10) ,STEP3,TIME=(0,10) ,CLASS=0,MSGCLASS=X, 

/ / N0TIFY=XRJRR 

II* STEP3 . INPUT IS "COEFFS" FILE ON UNIT #25 FROM STEP2. 

II* THIS PROGRAM READS GAUSS COEFFICIENTS IN FIT FORMAT AND WRITES 
II* THEM OUT IN FID FORMAT. 

II EXEC FORTRAN , PARM= ’ XREF ’ 

II SYSIN DD * 

INTEGER WORD (20) 

DATA NZERO / 0 / , MZERO / 0 / 

C SET SOME MORE FID PARAMETERS 

DATA MODEXT/O/ ,K/0/ ,ABAR/ 6371.2/ ,MODIND/0/ 

C READ IN TITLE FROM FIT FORMAT DATA, ON UNIT #1. 

READ (1 , 101 ) (WORD(I) ,1=1,20) 

101 FORMAT (20A4) 

C READ IN FIT INPUT PARAMETERS 

READ (1,102) NMAX , NMAXT , NMAXTT , NMAXT3 , EPOCH 

102 FORMAT ( 412, 16X.F10.0) 

C*** NOTE: FOR THIS VERSION OF THE PROGRAM ONLY, SET NMAXT=9 . **** 

NMAXT=9 

C WRITE OUT FID PARAMETERS 

WRI TE ( 2 , 2 0 1 ) NMAX , NMAXT , NMAXTT , NMAXT 3 , MODEXT , K , EPOCH , ABAR , 

> MODIND 

201 FORMAT ( 612, 2F6 . 1,12) 

C WRITE OUT TITLE 

WRITE(2, 101) (WORD(I) ,1=1,20) 

IC0UNT=0 

C READ IN GAUSS COEFFICIENTS AND WRITE OUT 
1 READ(1, 103) N,M,G,H, GT ,HT, GTT.HTT 

103 FORMAT ( 213, 6F12.0) 

WRITE(2,203) N,M,G,H,GT,HT, GTT.HTT 

203 FORMAT ( 213, 6F11. 4) 

C 

IF (N .LT. NMAX) GO TO 3 
IF (M .LT. NMAX) GO TO 3 
GO TO 5 
C 

3 ICOUNT = ICOUNT + 1 
NF = N 
MF = M 
GO TO 1 
C 

5 ICOUNT = ICOUNT + 1 

C PUT ZEROS AT THE BOTTOM OF THE DATA LIST 
WRITE (2, 203) NZERO, MZERO 
WRITE ( 2 , 203 ) NZERO, MZERO 
NF = N 
MF = M 

WRITE (6, 601) ICOUNT, NF.MF 
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601 FORMAT* ///,1 OX, ’NUMBER OF COEFFICIENTS IS: ’,13,/, 

> lOX.’MAX DEGREE= ’,I3,3X,’MAX ORDER= ’,13) 

C 

STOP 

END 

II EXEC LINKGO, REGION. GO=200K 

//GO.FTOlFOOl DD DSN=XRSHS. JAN1885.STEP2.C0EFFS,DISP=SHR 
//GO.FT02F001 DD DSN=XRSHS. JAN1885 . STEP3 .COEFFS,DISP=(NEW, CATLG) , 
II DCB=(RECFM=FB,LRECL=80,BLKSIZE=8000) , SPACE=(TRK, (2,2) ,RLSE) , 
II VOL=SER=SACC01 , UNIT=SYSDA 
II EXEC NOTIFYTS 
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VI. Further Data Processing 

Each of these sets was then further processed by rejecting data with 
high Kp or large DST indices. The DST index was added to each data point, 
and data in each set were sorted by geographical location (equal area bin). 
Finally, data in each bin were rejected, until a specified number (9 for 
dip-latitude > 30 degrees, 3 for dip-lat < 30) per bin was obtained. The 15 
sets were then concatenated into a single file, ready for input into the FIT 
program. 

Table 2 s umm arizes this process and indicates the input and output data 
sets used in the various programs. 

Programs and Processing Steps 


TABLE 2: PROCESSING OF DMSP DATA IN PREPARATION FOR FIELD MODELING 


PROGRAM INPUT OUTPUT 


FUNCTION 


DSTADD 

DATE. STEPS. OUTBIN TEMPFILE #1 
Dst tape 


Adds DST values, equal- 
area geographic bin 
numbers to data. Reject 
selected lengths of data 
with high K p and large 
DST indices. Sorts data 
by bin number. 


BINSIFT 

TEMPFILE #1 


DATE. SIFT. DATA 
(VBS , lrecl=116, 
Blksize=11604) 


Reduces the t of points in 
each equal-area bin down 
to a specified level. 
Point rejection criteria: 

1) points flagged by 
STEP5 , 

2) DST beyond the -5 to 
20 nT range, 

3) Random rejection. 


The output from this program, DATE. SI FT. DATA, becomes file 6 on the output 
tape . 


FITPREP 

DATE . SIFT . DATA 
(14 separate 
dates ) 


DMSP . FITPRP 
(VBS, lrecl=11204, 
Blksize=22412) 


Concatenates individual 
data sets into 1 file; 
puts data into FIT format 
(100 points per logical 
record) . 
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EUTRANS 


DMSP . FITPRP 

TEMPFILE #2 

Applies calibration values 
calculated in a FIT run to 
update the data. 

XYZTRANS 

TEMPFILE #2 

DMSP . FITXYZ 

Transforms spacecraft 


(VBS , lrec 1=11204 , 

coordinates to XYZ 

Format Information 

Blksize=22412) 

(topocentric ) coordinates . 
Data is in old FIT 
format. 


XRJRR.DMSP.FITPRP - Same format as File#6, except that data 

have been re-concatenated into 100 points per record. 

XRJRR.DMSP.FITXYZ - Same format as DMSP.FITPRP, except that A(11,I) holds X 
(north) component in topocentric coordinates, A(12,I) holds Y (east) 
component, A (13, I) holds Z (radial) component. 


VII. Data Tapes and Cartridges 
Programs and Related Information 

All programs and related data sets known to be relevant to DMSP data 
processing and evaluation have been collected and saved on Cartridge S01000. 
TABLE 3 summarizes the contents of this cartridge. 

Note that particular JCL was necessary to copy a load module onto the 
cartridge and that restoration of that load module also requires specific 
JCL. This JCL is given as follows: 
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1) To copy an IBM load module from a partitioned data set on a disk to a 
tape or cartridge file: 


/ /XR1RBFAT JOB (F8002,X22,10) , ’IEBCPY’ , CLASS=A, 

/ / MSGCLAS S=X , TIME= (.30), N0TIFY=XR1RB 

/*J0BPARM LINES=50 

//* XR1RB. LIB. CNTL( IEBCPY) 

II * 

II* THIS COPIES A LOAD MODULE ON DISK TO TAPE OR CARTRIDGE 

//* 

/ / exec pgm=iebcopy 

II SYSPRINT DD SYSOUT=* 

II SYSIN DD DUMMY 

/ / SYSUT1 DD DISP=SHR,DSN=XRJRR.FIT.DMSP.L0AD2 

II SYSUT2 DD DISP= (NEW, PASS ) , 

/ / UNIT=3480 , VOL=SER=S01000 , LABEL=( A , SL, ,OUT) , 

/ / DSN=OLDFIT3 

I* 


2) To copy a load module on a tape or cartridge file to a partitioned data 
set on disk. 


//X R1RBFAT JOB (F8002.X22, 10) , ’CPYDSK’ ,CLASS=A, 

II MSGCLASS=X, TIME=( ,30) , N0TIFY=XR1RB 

/* JOBPARM LINES=50 

II* XR1RB. LIB. CNTL( CPYDSK) 

" II* 

II* THIS COPIES A LOAD MODULE ON TAPE OR CARTRIDGE TO DISK 
II* PARTITIONED 

II EXEC PGM=IEBCOPY 

//SYSPRINT DD SYSOUT=* 

II SYSIN DD DUMMY 

II SYSUT1 DD DISP= (NEW, PASS ) , 

/ / UNIT=3480 , VOL=SER=S01000 , LABEL=( A , SL, , IN) , 

/ / DSN=OLDFIT3 

II SYSUT2 DD DSN=XR1RB. TEMPORY. NAME, SPACE=(TRK, (14,5,1) ,RLSE) , 

/ / DISP= (NEW, CATLG) , DCB= (RECFM=U, BLKSIZE=19069 ) ,UNIT=SYSDA 
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TABLE 3: CONTENTS OF CARTRIDGE S01000 
PROGRAMS AND DATA FOR PROCESSING DMSP DATA 


PROGRAM 
NAME OR 


FILE 

IDENTIFIER 

SOURCE 

COMMENTS 

* ♦ ♦ • 

* Basic Filter Program 


1 

FILTER 

XRTJS . DMSP . FILT . CNTL 



• Files for 

old FIT Program 


2 

OLD FIT ONE 

XRJRR . FIT . FILES (UPDMSP2 ) 

Update Deck 

3 

OLD FIT TVO 

YCDMM. FIT. FORT 

Standard Fit Source Code 

4 

OLD FIT THREE 

XRJRR . FIT . DMSP . L0AD2 

Load Module for 




fit used for DMSP 

5 

OLD FIT FOUR 

YCWDW. TPSYS . LOAD 

Standard Update Sys. 

6 

OLD FIT FIVE 

YCWDW. FITQ .LOAD 

Contains additional FIT 




items such as assembler 




version of DLOOP and 




FMOVE, FREAD, etc. 


Program to reformat SHA Coefficients 


7 

STEP3 

XRJRR . DTAPE . PROCESS ( STEP3 ) 

STAGE3 Run Deck 


. Programs 

to work with cleaned up data 


8 

BINSIFT 

XRJRR . DTAPE . PROCESS ( BINSIFT ) 

Run Deck 

9 

DSTADD 

XRJRR . DTAPE . PROCESS ( DSTADD ) 

Run Deck 

10 

FITPREP 

XRJRR . DTAPE . PROCESS ( FITPREP ) 

Run Deck 

11 

EUTRANS 

XRJRR . DTAPE . PROCES S ( EUTRANS ) 

Run Deck 

12 

XYZTRANS 

XRJRR . DTAPE . PROCESS (XYZTRANS ) 

Run Deck 


. . Deck Setups for the STAGES of Table 1 


13 

STEP1 

XRJRR . DTAPE . PROCESS ( STEP1 ) 

Run Deck for STAGE1 

14 

STEP2 

XRJRR . DTAPE . PROCESS ( STEP 2 ) 

Run Deck for STAGE2, 




using Load Module 

15 

STEP2B 

XRJRR . DTAPE . PROCESS ( STEP2B ) 

Run Deck for STAGE2, 




using source module 

16 

STEP4 

XRJRR . DTAPE . PROCESS ( STEP4 ) 

Run Deck for STAGE4 

17 

STEPS 

XRJRR . DTAPE . PROCESS ( STEP5 ) 

Run Deck for STAGES 


Source and Load Modules for Stages 1, 4 # and 

5 

18 

CODE1 

XRJRR . DTAPE . PROCESS 

Modified source code 




of FILTER and of 




BSPLYNE3 for DMSP 




processing. 

19 

SATFILT 

XRJRR. SATFILT 

Load module containing 


DMSP version of FILTER 
and BSPLINE. 
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. . Data or 

Model Input 


20 

CAL84FID 

XRJRR . DTAPE . PROCES S ( CAL84FID ) 

Initial field model 

21 

DST81 

XRJRR. DST81 

Yearly Dst 

22 

FITPRP 

XRJRR . DMSP . FITPRP 

Output Data 

23 

FITXYZ 

XRJRR. DMSP. FITXYZ 

Output Data 

24 

BSPINFO 

XRTJS . BSPINFO . DATA 

Bspline and Fourier 
parameters 


Miscellaneous Ridgway Programs 



From XRJRR . DMSP . PROGRAMS ( ) 


25 

ADDFLAG 


Flags Bspline outliers 
from FILTER before 
plotting 

26 

ADDFLAG2 


Same as ADDFLAG, except 
all bad points flagged 

27 

BSIG 


Computes stastics on 
DMSP data relative to 
selected field model. 

28 

LOOK 


Printout of STAGE5 
output . 

29 

POWPLT 


Power spectrum plotting 
routine . 


DMSP version 

of the BSPLINE Program 

General program for 
B-Spline and Fourier 
fitting. 

30 

BSPLINE 

XRTJS . LIB .MAG (BSPLYN3 ) 

Processed Data 




The following Table is a list of the original tapes as received from AFGL 
and a list of the tapes onto which the data was processed. The processed 
data tape is a six file tape; the formats of the six files are described in 
the following paragraphs. For permanent storage, the tapes were copied onto 
the indicated Cartridge: the first cartridge file contains the contents of 
the (one file) raw data tape from AFGL; the second through seventh cartridge 
files are files one through six of the processed data tape. 


DATE 

RAW DATA TAPE 

TAPE ON WHICH 

CARTRIDGE ON 


FROM AFGL 

PROCESSED DATA 
IS STORED 

WHICH TAPES 
ARE COPIED 

1/7-9/84 

DT0030 

DT0119 

S01011=S01012 

1/17-18/84 

MAG025 ,MAG026 

DT0120 

S01013=S01014 

3/19-21/84 

DT0031 

DT0121 

S01015=S01016 

5/6-8/84 

DT0105 

DT0122 

S01017=S01018 

these dates 

was "bad", not 

used in final modeling) 


6/20-23/84 

DT0106 

DT0123 

S01019=S01020 

8/20-23/84 

DT0107 

DT0124 

S01021=S01022 

9/16,17/84 

DT0108 

DT0125 

S01023=S01024 

1/18-20/85 

DT0109 

DT0127 

S01025=S01026 

5/23-25/85 

DT0111 

DT0128 

S01027=S01028 
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6/13-15/85 

DT0112 

DT0129 

S01029=S01030 

6/16-19/85 

DT0113 

DT0130 

S01031=S01032 

8/5-7/85 

DT0114 

DT0131 

S01033=S01034 

9/29-30/85 

DT0115 

DT0132 

S01035=S01036 

10/26-28/85 

DT0117 

DT0134 

S01039=S01040 

11/23-25/85 

DT0118 

DT0135 

S01041=S01042 


The input tapes from AFGL were one file of ASCII data with the following 
format : 

Tape characteristics: Non-labeled, 6250 BPI, Recfm^FB, Lrecl=75, Blksize 

= 1875, ASCII (OPTCD=Q) . 


Data format: 


Header record -- every 60 seconds: 


COLS 

VARIABLE 

TYPE 

1-4 

IYR 

INT 

5-8 

IDAYD 

INT 

9-14 

IETIME 

INT 

15-18 

I ALT 

INT 

19-28 

GLAT 

REAL 

29-38 

GLONG 

REAL 

39-48 

GMLAT 

REAL 

49-58 

GMLONG 

REAL 

59-68 

XMLT 

REAL 

72-75 

NS 

INT 


Data record 

-- every second 

COLS 

VARIABLE 

TYPE 

1-6 

IDSEC 

INT 

12-29 

XI , Y1 , Z1 

INT 

34-51 

X2,Y2,Z2 

INT 

56-75 

NF(1-10) 

INT 


DESCRIPTION 


Year 

Day number 

Time of record (seconds U.T.) 

Altitude (Nautical miles) 

Geographic latitude . 

Geographic longitude . 

Corrected geomagnetic latitude. 
Corrected geomagnetic longitude. 
Corrected geomagnetic local time. 

Number of data records following header 
(usually = 60) . 


DESCRIPTION 


Time of data recorcKsec U.T.) (16) 

Magnetometer counts for first of 20 
samples per second; 3 axes (316). 
Magnetometer counts for eleventh of 20 
samples per second; 3 axes (316). 

Ten data quality flags (1012) . 


The raw data tape from AFGL becomes the first file, ASCII, on the output 
cartridge. Files 1 through 5 on the output tape become files 2 through 6 on 
the cartridge. File 6 on the output tape, to be described later in this 
Section, becomes file 7 on the cartridge. 
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Storage of processed data: On the "processed data" tapes, and 

corresponding cartridges, the files are set up as follows (add one file 
number for cartridge files): 


File# Data File 

1 DATE . STEP2 . COEFFS 

2 DATE. STEP3 .COEFFS 

3 DATE . STEP4 . OUTF 

4 DATE . STEP5 . OUTBIN 

5 DATE . STEP5 . OUTF 

6 DATE. SIFT. DATA 


File characteristics 
FB, Lrecl=80, Blksize=5440 
FB, Lrecl=80, Blksize=5520 
FB, Lrecl=240 , Blksize=4800 
VBS , Lrecl=11204 , Blksize=22412 
FB, Lrecl=240,Blksize=4800. 

VBS ,Lrec 1=116, Blksize=11604 


Formats of processed data files: 

i) File #1 - Standard FIT coefficient format. 

ii) File #2 - Standard FDG coefficient format. 


iii) File #3,5 - Fixed block format: 


COLUMNS 

TYPE 

FORMAT 

DESCRIPTION 

1-2 

INT 

12 

Year 

3-6 

INT 

14 

Day . 

7-12 

INT 

16 

Seconds of day. 

13-19 

Real 

F7 . 2 

Geographic latitude . 

20-26 

Real 

F7.2 

Geocentric latitude . 

27-33 

Real 

F7 • 2 

Longitude . 

i 

-o 

o 

Real 

F7 . 2 

Dip-latitude . 

41-47 

Real 

F7.2 

Dip- longitude . 

CD 

Cn 

Real 

F7 . 2 

Altitude . 

55-61 

Real 

F7 . 2 

Geocentric Radius. 


62-69 

Real 

F8.1 

Crosss-track spacecraft mag. component 

70-77 

Real 

F8.1 

Radial spacecraft mag. component. 

78-85 

Real 

F8.1 

Along-track spacecraft mag. component. 

86-93 

Real 

F8.1 

Total field intensity. 

94-101 

Real 

F8.1 

Residual cross-track component. 

102-109 

Real 

F8.1 

Residual radial 

110-117 

Real 

F8.1 

Residual along-track 

118-125 

Real 

F8.1 

Residual total field intensity. 

126-133 

Real 

F8.1 

X (north) component. 

134-141 

Real 

F8.1 

Y (east) component. 

142-149 

Real 

F8.1 

Z (down) component. 

150-157 

Real 

F8.1 

Total field intensity. 

158-165 

Real 

F8.1 

Residual X component. 

166-173 

Real 

F8.1 

Residual Y component. 

174-181 

Real 

F8.1 

Residual Z component. 

182-189 

Real 

F8.1 

Residual total field intensity. 

190-197 

Real 

F8.1 

Model field, X component. 

198-205 

Real 

F8.1 

Model field, Y component. 

206-213 

Real 

F8.1 

Model field, Z component. 

214-221 

Real 

F8.1 

Model field, total intensity. 

222-226 

INT 

15 

Velocity direction flag (=+,-1) 

227-231 

INT 

15 

Data quality flag (=0 if good, 1-7 if 




bad) . 

232-239 

INT 

412 

Data indicator flags for X,Y,Z,B. 
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iv) File #4 - Binary FIT format (100 points per record, 28 

real*4 words per point): 

One of the common formats into the (old) field modeling program is 
called FIT format. Data from the POGO, Magsat and DMSP F-7 satellites 
are generally in this format, or a variation therof. These files are 
binary with 100 points per record and with each point having 28 REAL*4 
words of data, as follows: 


REAL*4 A(28 , 100 ) 
INTEGER IA(28 , 100 ) 
EQUIVALENCE (A (1,1), 

IA(1,1)) 

ARRAY LOCATION 

DESCRIPTION 

IA(l.I) 

Modified Julian Day. 

IA(2, I) 

Milliseconds of Day. 

A(3,I) 

Not used. 

A(4,I) 

In some cases not used. 

A(5,I) 

Time in years from 1900. 

A(6,I) 

Geocentric latitude . 

A( 7 , 1 ) 

Longitude. 

A(8, I) 

Not used. 

A(9,I) 

Not used. 

A(10 , I) 

Not used. 


If data are in geocentric coordinates: 

A(11,I) North component, -Bfl, or Satellite X-axis 

component . 

A(12,I) East component, B^, or Satellite Y-axis component 

A(13,I) Satellite Z-axis component (along-track) . 


If data are in spacecraft coordinates: 

A(11,I) Cross track component 

A(12,I) Radially down component 

A (13, I) Along track component 


A( 14 , 1) 
IA(15 , I ) 


A( 16 , 1 ) 
A( 17 , 1 ) 


Scalar total intensity. 

Geocentric altitude (meters) above earth radius, 
earth radius taken to be 6371.0 km. (Note: this 
standard Earth radius was used for Magsat. Other 
data used 6371.2. User beware.) 

Not used. 

Not used. 
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IA(18 , I ) 


Data quality classification 


IA(19 # I) 
IA(20 , I ) 


IA(21 , I) 
IA( 22 , I ) 

IA( 23 , I ) 

IA(24 , I ) 

IA( 25 v I ) 
A( 26 , 1 ) 
A(27 , I ) 
A(28 1 1 ) 


Used only for DMSP * 
flag (0-7); 

0 = Data is adequate quality 

1 = Residual from field model exceeds a 
specified cutoff (Gross outlier) 

2 = Padded time gap value (data does not 
actually exist here on tape.) 

3 = Outlier from B-spline function 

4 = Outlier from Fourier function 

5 

6 = Latitude of data exceeds specified 
geocentric latitude cutoff. 

7 = Direction of satellite indeterminable 

=0 

=0 except for DMSP where it indicates satellite 
velocity vector direction (=+,-1), + means going 
north; - means going south, if zero the direction 
is undetermined. 

=0 

Magnetic latitude outlier flag for sat. X axis. (0 
= no data; 2 = data) 

n n n unity" 

(0 = no data; 2 = data) 

It ft « " " " Z " 

(0 = no data; 2 * data) 

« « n »t w total intensity. 

Not used. 

Not used. 

Not used. 


v) File f 6 - Binary "pseudo-FIT" format (1 point per record, 28 real*4 
words per point) : Same as FIT format, except that IA(16) holds the 
geographic equal-area bin number, and IA(17) holds the DST hourly 
index. 
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Unprocessed Data 


The following Table is a list of original tapes from AFGL which were 
received after processing was suspended. 


DATE 

RAW DATA 

TAPE 

CARTRIDGE ON 


FROM AFGL 

WHICH TAPES 




ARE COPIED 

10/1/85 

DT0116 


S01037=S01038 

10/16-18/84 

DT0181 

(M4784 ) 

S01043=S01044 

1/11-14/86 

DT0182 

(M5098) 

S01045= s S01046 

3/9-12/86 

DT0183 

(M5097) 

S01047=S01048 

5/13-15/86 

DT0184 

(M4785) 

S01049=S01050 

5/28-30/86 

DT0185 

(M5099) 

S01051=S01052 

6/25-26/86 

DT0186 

(M5100) 

S01053=S01054 

7/14-15/86 

DT0187 

(M5101) 

S01055-S01056 

7/16 

DT0188 

(M5102) 

S01057=S01058 

8/16-18/86 

DT0189 

(M5103) 

S01059=S01060 

9/8/86 

DT0190 

(M5218 ) 

S01061=S01062 

9/16,22/86 

DT0191 

(M5104 ) 

S01063=S01064 

10/10-12/86 

DT0192 

(M5215 ) 

S01065=S01066 

11/8-10/86 

DT0193 

(M5216 ) 

S01067=S01068 

11/21-23/86 

DT0194 

(M5217 ) 

S01069=S01070 

12/5-6/86 

DT0195 

(M5270) 

S01071=S01072 

??????????? 

DT0196 

(M4050 ) 

S01073=S01074 

2/15/85 

DT0216 

(M4786 ) 

S01075=S01076 

4/18/85 

DT0217 

(M4788 ) 

S01077=S01078 

2/16/86 

DT0218 

(M4787 ) 

S01079=S01080 


These tapes and cartridges are one file, ASCII, in the same format as the 
first file on the tapes with processed data. 
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VIII. Individual Epoch DMSP Field Models 


The correction procedure was applied to 15 sub-sets of DMSP data, each 
containing several days of data. These are the data in the processed tapes 
and cartridges of the previous section. Subset epochs ranged from January, 
1984 through November, 1985. Each data set was chosen from a magnetically 
quiet period as determined by the world-wide Kp index. Results of STAGE 2, 
which solves for the field model and magnetometer adjustment parameters, are 
summarized in Table 4. 

Table 4 


Date 

gl° 

gl 1 

hi 1 


e y 

e z 

BIAS1 

BIAS 2 

BIAS 3 

yrs 

nT 

nT 

nT 

deg 

deg 

deg 

nT 

nT 

nT 

84.02 

-29895 

-1927 

5522 

-.038 

-.449 

0.005 

12.0 

2.6 

-1.7 

84.05 

-29893 

-1928 

5532 

-.065 

-.446 

0.006 

0.2 

-.5 

1.4 

84.21 

-29887 

-1935 

5523 

-.114 

-.459 

-.004 

7.8 

2.7 

-8.7 

84.34 

-29872 

-1925 

5516 

-.172 

-.457 

-.013 

11.4 

-2.0 

-12.5 

84.47 

-29860 

-1922 

5514 

-.138 

-.451 

-.016 

2.4 

-7.6 

-11.2 

84.63 

-29866 

-1932 

5503 

-.063 

-.474 

-.009 

-11.9 

-12.1 

-3.8 

84.71 

-29866 

-1927 

5505 

-.092 

-.478 

-.006 

-18.4 

-9.5 

-2.4 

85.05 

-29857 

-1918 

5496 

-.050 

-.496 

-.022 

-91.2 

-56.7 

20.0 

85.34 

-29856 

-1910 

5492 

-.129 

-.471 

-.013 

-91.2 

-67.0 

4.1 

85.45 

-29838 

-1920 

5494 

-.125 

-.467 

-.017 

-93.6 

-68.3 

1.3 

85.46 

-29843 

-1916 

5491 

-.130 

-.472 

-.020 

-86.7 

-65.9 

1.3 

85.60 

-29842 

-1915 

5495 

-.098 

-.475 

-.009 

-100.4 

-74.2 

4.6 

85.75 

-29847 

-1908 

5490 

-.074 

-.520 

0.013 

-112.6 

-72.3 

7.3 

85.82 

-29843 

-1914 

5484 

-.081 

-.511 

0.021 

-113.1 

-63.7 

12.8 

85.90 

-29832 

-1905 

5489 

-.030 

-.518 

0.032 

-110.0 

-57.5 

25.7 


Figures 4a) through 4e) are derived from Table 4. They display 
solutions for gi°, gi 1 , hi 1 , the three Euler angles, and the three biases 
for each DMSP data set throughout time. The main field coefficients 
decrease in magnitude with time as expected from earlier models, but the 
trend is not smooth. This could indicate that the data sub- sets have 
marginal geographic distribution, or that the DMSP data are not sufficiently 
stable over time. The Euler angle solutions are fairly consistent, with £y 
(yaw) varying slowly from -.44 to -.52 degrees, £x (pitch) averaging about 
-.1 degrees and e z (roll) averaging about zero. The bias values show a 
noticeable break between September, 1984 and January, 1985, most strongly in 
X and Y. Biases at January, 1985 depart sharply from the previous bias 
trend in all three components. This jump is evident in the biases only, and 
its cause is uncertain. One possible explanation is that on 30 October, 
1984, the solar array panel was rotated 90°. This could result in a changed 
contribution to the bias field from the solar array since both its position 
and its total current were changed. Another, though less likely, spacecraft 
change that could contribute to the bias change is that on 7 November, 1984, 
the skew momentum wheel was reset so that it drew 100 ma less current. 
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The bias values in Table 4 are part of the value of the vector 
parameter bias to be used in equation 3), i.e. they are a small time 
dependent correction to be applied in addition to the large bias values of 
equation 2)* A small further correction is derived in section IX of paper 
1 * 
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Figure Captions 


Figure # 


Caption 


1 DMSP orbital X, Y, and Z magnetic component data which have 
had an estimated field model removed, revealing strong 
periodicities in the residuals. The dashed line is a spline 
fit to the residuals. 

2 Power spectra of X and Y DMSP residual data from Figure 1. 

3 Y-component of DMSP data from Figure 1, demonstrating removal 
of outliers, magnetometer rotation and bias correction, and 
subtraction of Fourier periodic function. The dashed line is a 
spline fit to the residuals. 

4 Plots of gi°, gi 1 , hi*, Euler angles, and biases versus time 
(yrs ) , for field model solutions from 15 DMSP data sets 
spanning 1984 - 1986. 


51 



COMPONENT 
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DMSP PDWFR SPECTRUM: X COMPONENT 
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DMSP POWER SPECTRUM: Y COMPONENT 
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FIGURE 2 



RESIDURL Y COMPONENT : UNPROCESSED 
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FIGURE 4e 




APPENDIX 


This appendix contains listings of the primary programs used in the 
processing of the DMSP data. Most of these are documented with 
internal comments. 


A-l 



PROGRAM FILTER 


C 


C==============a 


c 


C PROGRAM TO PRE-PROCESS SATELLITE MAGNETIC VECTOR DATA. THE PROGRAM IS 
C COMPRISED OF FIVE STEPS, EACH MODULARLY DESIGNED: 

C 

C STEP 1: 

C ====== 

C 

C PERFORMED IN SUBROUTINE STEP1, IT INVOLVES THE READING OF AN ORIGINAL 
C SATELLITE MAGNETIC DATA TAPE, AND TRANSFORMING THE RAW MAGNETOMETER 
C COUNTS TO MAGNETIC FIELD VALUES IN THE SPACECRAFT COORDINATE SYSTEM. 

C 

C STEP 2: 

C ====== 

C 

C PERFORMED IN SUBROUTINE STEP2, IT INVOLVES THE LOCATION AND PADDING OF 
C TIME GAPS IN THE DATA, AND THE DETERMINATION OF THE DIRECTION OF THE 
C SPACECRAFT VELOCITY VECTOR AT EACH MEASUREMENT LOCATION. 

C 

C STEP 3: 

C ====== 

C 

C PERFORMED IN SUBROUTINE STEP3, IT INVOLVES THE TRANSFORMATION OF THE 
C MAGNETIC FIELD MEASUREMENTS FROM SPACECRAFT TO TOPOCENTRIC COORDINATE 
C SYSTEM FROM WHICH RESIDUAL MEASUREMENTS ARE DETERMINED FROM A GIVEN 
C FIELD MODEL. DATA LOCATIONS AT WHICH ANY VECTOR RESIDUAL EXCEEDS THE 
C SPECIFIED TOLERANCE ARE FLAGGED AS OUTLIERS. 

C 

C STEP A: 

C ====== 

C 

C PERFORMED IN SUBROUTINE STEP A, IT INVOLVES FITTING A TREND TO THE 
C MAGNETIC FIELD RESIDUALS WITH B-SPLINES AND/OR FOURIER WAVEFORMS, WITH 
C THE OPTION OF FLAGGING POINTS WHOSE TREND RESIDUALS EXCEED A GIVEN 
C TOLERANCE AND THE OPTION OF DETRENDING THE ORIGINAL DATA. 

C 

C STEP 5: 

C ====== 

c 

C PERFORMED IN SUBROUTINE STEPS, IT INVOLVES OUTPUTTING A FINAL MODIFIED 
C SATELLITE MAGNETIC DATA TAPE IN THREE BASIC FORMS: 

C 

C (1) EBCDIC TAPE IN TOPOCENTRIC COORDINATES 

C (2) EBCDIC TAPE IN DESIRED SPACECRAFT COORDINATES 

C (3) BINARY TAPE IN OLD FIT PROGRAM FORMAT (MAGSAT CONVENTION) 

C 

C 

C 

C PROGRAM FILTER MAY RUN IN ONE OF FOUR MODES INDICATED BY THE INPUT 
C VARIABLE IMODE: 

C 

C IMODE = 0; 

C ========= 

c 

C PERFORM STEPS 1, 2, 3, 4, AND 5 
C 

C IMODE = 1: 

C ========= 
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c 

C PERFORM STEPS 4, AND 5 
C 

C IMODE =2: 

C ========= 

c 

C PERFORM STEP 4 
C 

C IMODE = 3: 

C ========= 

c 

C PERFORM STEPS 1, 2, 3, AND 4 
C 



C 

C PROGRAM FILTER OPERATION IS GOVERNED BY VARIABLES INPUT THROUGH FIVE 
C NAMELIST CATAGORIES : 

C 

C CONTRL: 

C ====== 

c 

C GOVERNS PROGRAM MODE AND EPHEMERIS PROCESSING DETAILS. 

C 

C IOFILE : 

C ====== 

c 

C ESTABLISHES PROGRAM LOGICAL UNITS. 

C 

C BSPLIN : 

C ====== 

c 

C PROVIDES VECTOR MEASUREMENT SIGMAS AND INFORMATION CONCERNING TREND 
C FITTING VIA B-SPLINES AND/OR FOURIER WAVEFORMS. 

C 

C OUTLIM: 

C ====== 

c 

C PROVIDES RESIDUAL FIELD TOLERANCE LEVELS, MAGNETIC LATITUDE TOLERANCE 
C LEVELS, GEOCENTRIC LATITUDE TOLERANCE LEVEL, GEODETIC LATITUDE ABOVE 
C WHICH SPACECRAFT VELOCITY VECTOR DIRECTION IS INDETERMINABLE, AND TIME 
C GAP TOLERANCE LEVEL. 

C 

C FIELDP : 

C ====== 

c 

C PROVIDES INFORMATION FOR THE APPLICATION OF THE GIVEN MAGNETIC FIELD 
C MODEL TO BE USED AS A BASIS FOR RESIDUAL FIELD MEASUREMENTS. 

C 

C TRFORM: 

C ====== 

c 

C PROVIDES VARIOUS ROTATION ANGLES, SLOPES, AND BIASES USED TO TRANSFORM 
C THE RAW MAGNETOMETER COUNTS TO MAGNETIC FIELD VALUES IN THE SPACECRAFT 
C COORDINATE SYSTEM. 

C 



C 

C PROGRAM FILTER REQUIRES UP TO THREE INPUT DATA SETS LOCATED ON THE 
C FOLLOWING LOGICAL UNITS: 

C 
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C IST1: 

c 

C SATELLITE MAGNETIC VECTOR MEASUREMENTS IN RAW MAGNETOMETER COUNTS, 

C CURRENTLY IN DMSP SATELLITE FORMAT . 

C 

C I OCF : 

C 

C MAGNETIC FIELD MODEL INFORMATION IN PROGRAM FID FORMAT. 

C 

C IOBS: 

C 

C B-SPLINE KNOT POSITIONS, FOURIER WAVEFORM FREQUENCIES, AND OBSERVATION 
C SIGMAS FOR MAGNETIC FIELD VALUES. 

C 

C 

c 

c GLOSSARY OF PROGRAM FILTER NAMELIST ITEMS 

C 

c NAMELIST IOFILE - 

C 

c IST1 

c 

C IST2 

C 

c 

C IST3 

C 
C 

C I ST A 

c 
c 

C I OR 

C 
C 

C IOW 

C 

C IOF 

c 
c 
c 

c IOD 

C 
C 

C IOB 

C 

c 

C I SCI 

C 

C ISC2 

c 

C ISC3 

C 
C 

C NAMELIST FIELDP - 


- INPUT UNIT FOR ORIGINAL RAW DATA TAPE(S) IN STEP1 . 

- INPUT UNIT IN STEP2, OUTPUT UNIT IN STEP1, MAGNETIC FIELD 
IN FIT/MAGSAT COORDINATES. 

- INPUT UNIT IN STEP3, OUTPUT UNIT IN STEP2, VELOCITY 
DIRECTIONS AND PADDED TIME-GAPS. 

- INPUT UNIT IN STEP*, OUTPUT UNIT IN STEP3, MAGNETIC FIELD 
AND RESIDUALS IN TOPOCENTRIC COORDINATES. 

- FILTER INPUT UNIT, SAME AS 1ST* IN OPERATION MODE 0 
AND 3. 

- FILTER OUTPUT UNIT, INPUT UNIT IN STEPS. 

- OUTPUT UNIT IN STEPS, FORMATTED MAGNETIC FIELD IN FIT/ 
MAGSAT OR TOPOCENTRIC COORDINATES DEPENDING ON IBTBS 
VALUE. 

- OUTPUT UNIT IN STEPS, FORMATTED MAGNETIC FIELD IN DESIRED 
SPACECRAFT COORDINATES. 

- OUTPUT UNIT IN STEPS, BINARY MAGNETIC FIELD IN PROGRAM 
FIT FORMAT. 

- FILTER SCRATCH UNIT. 

- FILTER SCRATCH UNIT. 

- SCRATCH UNIT USED IN SUBPROGRAM DPINFO TO STORE VARIOUS 
DATA PARAMETERS. 
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c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


JJ - FID INPUT POSITION COORDINATES: (0) GEODETIC 

(1) GEOCENTRIC. 

MM - FID EQUITORIAL RADIUS AND RECIPROCAL FLATTENING: 

(0) DEFAULT AE = 6378.16 KM, FLAT = 298.25 (1) INPUT 
VALUES. 

NMX - MAXIMUM DEGREE OF FID MODEL EVALUATION. 

NEXT - EXTERNAL FIELD MODEL: CO) DO NOT EVALUATE Cl) EVALUATE. 

IOCF - INPUT UNIT IN FID FOR COMPUTED MAGNETIC FIELD MODEL. 

IDST - INDUCED FIELD COEFFICIENTS* CO) DO NOT EVALUATE 

Cl) EVALUATE. 

DST - DST VALUE. 

LL - FID FIELD EVALUATION MODE: C-l) EVALUATE AT OLD TIME 

CO) EVALUATE Cl) READ FIELD MODEL AND EVALUATE. 

NAMELIST BSPLIN - 


H - ARRAY CONTAINING NUMBER OF INTERNAL KNOTS FOR B-SPLINE 

FUNCTIONS FITTING X, Y, AND Z COMPONENTS, RESPECTIVELY. 

NN - ARRAY CONTAINING ORDER OF B-SPLINE FUNCTIONS FITTING X, 

Y, AND Z COMPONENTS, RESPECTIVELY. 

NT - ARRAY CONTAINING NUMBER OF FOURIER WAVEFORMS FITTING X, 

Y, AND Z COMPONENTS, RESPECTIVELY. 

KA - B-SPLINE INTERNAL KNOT ADJUSTMENT FOR BEST FIT WITH 

RESPECT TO WEIGHTED RMS: CO) DO NOT ADJUST (1) ADJUST 

ITERMX - MAXIMUM NUMBER OF ITERATIONS IN UNIVARIANT SEARCH FOR 
OPTIMUM B-SPLINE KNOT POSITIONS. 

LGRMAX - MAXIMUM NUMBER OF ITERATIONS IN LAGRANGIAN INTERPOLATIVE 
SEARCH FOR BEST POSITION OF A PARTICULAR KNOT WITH 
RESPECT TO WEIGHTED RMS. 

EPS - KNOT ADJUSTMENT TOLERANCE WITHIN WHICH THE KNOT POSITION 
IS CONSIDERED TO HAVE CONVERGED. 

KO - BOOLEAN NUMBER IN WHICH EACH DIGIT GOVERNS THE ADJUSTMENT 
OF A PARTICULAR INTERNAL KNOT POSITION, WITH LEFT-MOST 
DIGIT CORRESPONDING TO LEFT-MOST KNOT* CO) ADJUST 
Cl) DO NOT ADJUST. 

IOBS - INPUT UNIT CONTAINING B-SPLINE KNOT POSITIONS, FOURIER 
WAVEFORM FREQUENCIES, AND SIGMAS FOR OBSERVED MAGNETIC 
FIELD VALUES. 

NAMELIST TRFORM - 
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c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


EU - FIT EULER ANGLES (DEGREES). 

QI - GSFC NOMINAL BIAS CORRECTIONS IN ORIGINAL SATELLITE 
COORDINATES (NT). 

QF - FIT MAGNETOMETER BIAS ADJUSTMENTS (NT). 

CF - FIT CALIBRATION SLOPE ADJUSTMENT MATRIX. 

CA - CALIBRATION MATRIX IN ORIGINAL SATELLITE COORDINATES. 

RF - ROTATION MATRIX FROM ORIGINAL SATELLITE TO FIT/MAGSAT 

COORDINATES. 

RC - ROTATION MATRIX FROM FIT/MAGSAT TO DESIRED SATELLITE 
COORDINATES. 

NAMELIST CONTRL - 


IMODE - PROGRAM OPERATION MODE: (0) RAW-TO-FINAL FIT TAPE TOTAL 

PROCESSING (1) FILTER-TO-FINAL FIT TAPE PROCESSING 
(2) FILTER PROCESSING ONLY (3) RAW-TO-FILTER TAPE 
PROCESSING. 

I FORM - ORIGINAL RAW DATA TAPE(S) FORMAT: (0) EARLY FORMAT — 

2 SAMPLES/SECOND (1) LATTER FORMAT — 20 SAMPLES/ SECOND 

NDATAR - NUMBER OF DATA RECORDS PROCESSED AFTER EPHEMERIS RECORD. 

INPUTF - NUMBER OF INPUT FILES TO BE PROCESSED. 

I ARC - ARC PROCESSING LENGTH: (0) ENTIRE ARC (1) ARC SEGMENT 

BETWEEN BEGINNING AND ENDING TIMES ONLY. 

IYRBEG - BEGINNING ARC TIME YEAR SINCE 1900. 

IDYBEG - BEGINNING ARC TIME DAY NUMBER. 

ISCBEG - BEGINNING ARC TIME SECONDS. 

IYREND - ENDING ARC TIME YEAR SINCE 1900. 

IDYEND - ENDING ARC TIME DAY NUMBER. 

ISCEND - ENDING ARC TIME SECONDS. 

ORBINC - SATELLITE ORBIT INCLINATION ANGLE (DEGREES). 

ERAD - MEAN EARTH RADIUS (KM). 

IEPDAY - FILTER REFERENCE DAY NUMBER. 

INCREM - FILTER WINDOW LENGTH (SECONDS). 

INTRVL - FILTER WINDOW NUMBER FROM BEGINNING OF REFERENCE DAY. 

IMETH - FILTER METHOD; (0) DETREND (1) DETREND AND FLAG 
OUTLIERS (2) FLAG OUTLIERS (3) NO MODIFICATION. 


A- 6 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c= 

c 


ISPEC - FFT SPECTRAL ANALYSIS: (0) NO ANALYSIS Cl) ZERO-MEAN 

ANALYSIS (2) DIRECT ANALYSIS. 

NEXTIN - NUMBER OF SUCCESSIVE FILTER WINDOWS TO BE PROCESSED 

DURING THIS RUN BEGINNING WITH WINDOW NUMBER "INTRVL". 

IBTBS - FINAL TAPE OUTPUT COORDINATES: CO) FORMATTED TOPOCENTRIC 

Cl) FORMATTED/BINARY FIT/MAGSAT (2) SAME AS 1, PLUS 
FORMATTED DESIRED SATELLITE. 

SIGMLT - OUTLIER MULTIPLICATION FACTOR FOR TREND RESIDUAL SIGMA. 

NFLAGK - DATA QUALITY FLAG RETENTION CODE FOR FILTER: EACH DIGIT 

INDICATES FLAG TO BE RETAINED FOR TREND FITTING. 

IOWIOF - UNIT IOW INTERVALS FOR FINAL PROCESSING* CO) INTRVL ONLY 
(1) INTRVL AND PRECEEDING C2) ALL. 

IOF1ST - OUTPUT DATA FLAG FOR UNITS IOF AND IOB: CO) DATA WILL BE 

APPENDED Cl) DATA WILL BE FIRST. 

IOD1ST - OUTPUT DATA FLAG FOR UNIT IOD: CO) DATA WILL BE APPENDED 

(1) DATA WILL BE FIRST. 

IOW1ST - OUTPUT DATA FLAG FOR UNIT IOW: CO) DATA WILL BE APPENDED 

Cl) DATA WILL BE FIRST. 


NAMELIST 

OUTLIM - 






DXOL 


MAGNITUDE 

TOLERANCE 

FOR 

RESIDUAL 

TOPOCENTRIC 

X 



COMPONENT 

(NT) . 





DYOL 

- 

MAGNITUDE 

TOLERANCE 

FOR 

RESIDUAL 

TOPOCENTRIC 

Y 



COMPONENT 

(NT) . 





DZOL 

- 

MAGNITUDE 

TOLERANCE 

FOR 

RESIDUAL 

TOPOCENTRIC 

Z 



COMPONENT 

(NT) . 





DBOL 

- 

MAGNITUDE 

TOLERANCE 

FOR 

RESIDUAL 

TOPOCENTRIC 

B 



COMPONENT 

(NT) . 






XWINDO - MAGNETIC LATITUDE TOLERANCE FOR FIT/MAGSAT X COMPONENT. 

YWINDO - MAGNETIC LATITUDE TOLERANCE FOR FIT/MAGSAT Y COMPONENT. 

ZWINDO - MAGNETIC LATITUDE TOLERANCE FOR FIT/MAGSAT Z COMPONENT. 

BWINDO - MAGNETIC LATITUDE TOLERANCE FOR FIT/MAGSAT B COMPONENT. 

ABVLAT - FILTER GEOCENTRIC LATITUDE TOLERANCE FOR ALL COMPONENTS. 

TRNLAT - GEODETIC LATITUDE ABOVE WHICH SATELLITE VELOCITY 
DIRECTION IS INDETERMINABLE. 

ITMGAP - TIME-GAP TOLERANCE INCREMENT FOR DATA CSECONDS). 


CHARACTER*80 TITLE 
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INTEGER H(3) 

DIMENSION EU(3),CA(3,3),QI(3),QF(3),CF(3),RF(3,3),RC(3,3),NN(3) 
DIMENSION NT(3),KA(3),ITERMX(3),LGRMAX(3),EPS(3),KO(3),SIG(3,500) 
DIMENSION EKNOTSC 3> 500), FREQ (3, 500) 

NAMELIST /IOFILE/ IST1 , IST2, IST3, IST4, IOR, ION, IOF, IOD, IOB, ISC1 , 

* ISC2,ISC3 

NAMELIST /FI EL DP/ J J ,MM, NMX, NEXT, IOCF, IDST, DST, LL 
NAMELIST /BSPLIN/ H, NN, NT, KA, ITERMX, LGRMAX, EPS, KO, IOBS 
NAMELIST /TRFORM/ EU, QI , QF, CF, CA, RF, RC 

NAMELIST /CONTRL/ IMODE, IFORM, NDATAR, INPUTF, IARC, IYRBEG, IDYBEG, 

* ISCBEG, IYREND, IDYEND, ISCEND, ORBINC, ERAD, IEPDAY, 

* INCREM, INTRVL , IMETH, ISPEC, NEXTIN, IBTBS, SIGMLT, 

* NFLAGK, IOWIOF, IOF1ST, IOD1ST, IOW1ST 

NAMELIST /OUTLIM/ DXOL , DYOL , DZOL , DBOL , XWINDO, YWINDO,ZWINDO, BWINDO, 

* ABVLAT , TRNLAT , ITMGAP 
COMMON /STFILE/ IST1 , IST2, IST3, ISTA 

COMMON /MDFILE/ IOR, IOW, IOF, IOD, IOB, IOF1ST, IOD1ST, IOW1ST, IOWIOF 
COMMON /SCFILE/ ISC1 , ISC2, ISC3 

COMMON /ARCLIM/ IARC, IYRBEG, IDYBEG, ISCBEG, IYREND, IDYEND, ISCEND, 

* IFORM,NDATAR, INPUTF 

COMMON /IFIELD/ JJ , MM, NMX, NEXT, IOCF, IDST, DST, LL 

COMMON /SPLINE/ H, NN, NT, KA, ITERMX, LGRMAX, EPS, KO, SIG, EKNOTS, FREQ 

COMMON /COTRAN/ EU, CA, QI , QF, CF, RF, RC 

COMMON /EPHEMS/ ORBINC, ERAD, IEPDAY, INCREM, INTRVL 

COMMON /FILTOP/ IMETH, ISPEC, IBTBS, SIGMLT, NFLAGK 

COMMON /LIMITS/ DXOL , DYOL , DZOL , DBOL , XWINDO, YWINDO, ZWINDO, BWINDO, 

* ABVLAT, TRNLAT, ITMGAP 
DATA IOBS /22/ 

READC5, 100 ) TITLE 

100 FORMAT (A80) 

READ(5, CONTRL) 

READC5, IOFILE) 

READC5, BSPLIN) 

READ( 5, OUTLIM) 

IFC ( IMODE . EQ . 0 ) . OR . ( IMODE . EQ . 3) ) READ( 5 , FIELDP) 

IFCIM0DE.NE.2) READC5, TRFORM) 

WRITEC6 , 101 ) 

101 FORMAT ( IX, * KXKKXXK*XKXXXX*KKKXXX*XKXXXKXXXXXXXXXKXKKKKXXXXKXKXKKKK 
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXKXXXXXXXXXKMKXXX'/Ix, * XXXX 
XGSFC SATELLITE MAGNETIC DATA PRE- 
xPROCESSING PROGRAM xxxxviX, *xxxxxxxxxxxxxxxxxxx 
XXXXXXXXXXXKXXXXKXXXXXXKXXXXXXXXXXXXXXXXXXXXXXXKXXKXXXXXXXXXXXXXXXX 
XXXXXXXXXXXXXXXXXXXXXXXXXXX • // ) 

WRITEC6 ,102) IMODE 

102 FORMATt IX, 'PROGRAM OPERATION MODE --> IMODE = ^,11,' (0) RA 

XW-TO-FINAL FIT TAPE TOTAL PR0CESSING'/A5X, * C 1 ) FILTER-TO-FINAL FIT 
x TAPE PR0CESSINGVA5X, '(2) FILTER PROCESSING 0NLY'/A5X, * (3) RAH-TO 
x-FILTER TAPE PROCESSING'//) 

WRITE(6, 103) I FORM 

103 FORMATdX, 'TAPE FORMAT MODE --> I FORM = ',11,' (0) EARLY FO 

XRMAT -- 2 SAMPLES/S ECONDV39X, • ( 1 ) LATTER FORMAT — 20 SAMPLES/S 

XECOND'//) 

WRITEC 6,104) TITLE 

104 FORMATCIX, 'TITLE --> ',A80//) 

WRITE(6 , 105) ORBINC, ERAD, IEPDAY, INCREM, INTRVL , IMETH, ISPEC, NEXTIN, 
XIBTBS, SIGMLT, NDATAR, INPUTF 

105 FORMATdX, '<CONTROL AND EPHEMERIS INFORMATIONS- '//IX, 'ORBINC = • , F7 
x.2, * --> SATELLITE ORBIT INCLINATION ANGLE (DEGREES) '/IX, 'ERAD 

X— ' , F7 . 2, • — > MEAN EARTH RADIUS (KM) '/IX, • IEPDAY = ',17,' --> F 
XILTER REFERENCE DAY NUMBER'/IX, 'INCREM = ’,17, » --> FILTER WINDOW 
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X LENGTH (SECONDS) '/IX, 'INTRVL = ',17,' — > FILTER WINDOW NUMBER F 
XROM BEGINNING OF REFERENCE DAY'/IX, ' IMETH = ',17, » — > FILTER ME 
*THOD: (0) DETREND (1) DETREND AND FLAG OUTLIERS C2) FLAG OUTLIE 

XRS (3) NO MODIFICATION'/IX, 'ISPEC = ’,17,' — > FFT SPECTRAL ANA 
XLYSISt (0) NO ANALYSIS (1) ZERO-MEAN ANALYSIS (2) DIRECT ANALYS 
XIS'/1X, 'NEXTIN = ’,17,* --> NUMBER OF SUCCESSIVE FILTER WINDOWS T 
XO BE PROCESSED DURING THIS RUN BEGINNING WITH WINDOW NUMBER INTRVL 
X’/1X, 'IBTBS = ',17,' — > FINAL TAPE OUTPUT COORDINATES: (0) FMT 

X TOPOCENTRIC (1) FMT/BIN FIT/MAGSAT (2) SAME AS 1, PLUS FMT DESI 
XRED’/1X, 'SIGMLT = ',F7.3,' — > OUTLIER MULTIPLICATION FACTOR FOR 
XTREND RESIDUAL SIGMA'/IX, 'NDATAR = * , 17, ' --> NUMBER OF DATA RECO 
XRDS PROCESSED AFTER EPHEMERIS RECORD’/IX, • INPUTF = ’,17,* — > NUM 
XBER OF INPUT FILES TO BE PROCESSED') 

WRITEC6 , 106) NFLAGK, IOF1ST, IOD1ST, IOW1ST, IOWIOF 

106 FORMATC IX, 'NFLAGK = ’,17,' — > DATA QUALITY FLAG RETENTION CODE F 

XOR FILTER: EACH DIGIT INDICATES FLAG TO BE RETAINED FOR TREND FIT 

XTING'/1X, 'IOF1ST = ’,17,' --> OUTPUT DATA FLAG FOR UNITS IOF AND 
XI OB : (0) DATA WILL BE APPENDED (1) DATA WILL BE FIRST'/IX, ' IOD1S 

XT = ’,17,' --> OUTPUT DATA FLAG FOR UNIT IOD: (0) DATA WILL BE A 

XPPENDED (1) DATA WILL BE FIRST'/IX, 'IOW1ST = ',17,' — > OUTPUT D 
XATA FLAG FOR UNIT IOW: CO) DATA WILL BE APPENDED Cl) DATA WILL B 

XE FIRST'/IX, 'IOWIOF = ',17,' — > UNIT IOW INTERVALS FOR FINAL PRO 
XCESSING: (0) INTRVL ONLY (1) INTRVL AND PRECEEDING C2) ALL'//) 

WRITE(6 ,107) IARC 

107 FORMATC1X, '<SATELLITE ARC PROCESSING INFORMATIONS-' ,//lX, * IARC 

X» , 15, ' --> ARC PROCESSING LENGTH: (0) ENTIRE ARC Cl) ARC SEGMEN 

XT BETWEEN BEGINNING AND ENDING TIMES ONLY') 

IFCIARC.EQ.O) WRITEC 6,108) 

108 FORMATC/) 

IFCIARC.EQ.l) WRITEC6, 109) IYRBEG, IDYBEG, ISCBEG, IYREND, IDYEND, 
XISCEND 

109 FORMATC IX, 'IYRBEG = ',15,' — > BEGINNING TIME YEAR SINCE 1900 '/IX 
X, 'IDYBEG = * , 15, ' --> BEGINNING TIME DAY NUMBER '/IX, 'ISCBEG = ',1 
X5, ’ --> BEGINNING TIME SECONDS '/IX, ' IYREND = ',15,' --> ENDING T 
XIME YEAR SINCE 1900 '/IX, ' IDYEND = ’,15,' — > ENDING TIME DAY NUMB 
XER'/IX, 'ISCEND = ’,15,' --> ENDING TIME SECONDS'//) 

WRITEC6 , 110) IST1, IST2, IST3, IST4, IOR, IOW, IOF, IOD, IOB, ISC1 , ISC2, 
XISC3 

110 FORMATC IX, *<INPUT/OUTPUT FILE INF0RMATI0N>'//1X, 'IST1 = ',12,' — > 
X INPUT UNIT FOR ORIGINAL RAW DATA TAPECS) IN STEP1 '/IX, • IST2 = ’, 
XI2, ' --> INPUT UNIT IN STEP2, OUTPUT UNIT IN STEP1, MAGNETIC FIEL 
XD IN FIT/MAGSAT COORDINATES '/IX, ' IST3 = ',12,' — > INPUT UNIT IN 
XSTEP3, OUTPUT UNIT IN STEP2, VELOCITY DIRECTIONS AND PADDED TIME-G 
XAPS'/IX, '1ST A = ',12,' — > INPUT UNIT IN STEP4, OUTPUT UNIT IN ST 
XEP3, MAGNETIC FIELD AND RESIDUALS IN TOPOCENTRIC COORDINATES'/IX, ' 
XIOR = ’,12,' — > FILTER INPUT UNIT, SAME AS IST<* IN OPERATION MO 
XDE 0 AND 3'/lX, * IOW = ',12,' — > FILTER OUTPUT UNIT, INPUT UNIT 
XIN STEP5'/1X, 'IOF = ',12,' --> OUTPUT UNIT IN STEPS, FORMATTED M 
XAGNETIC FIELD IN FIT/MAGSAT OR TOPOCENTRIC COORDINATES DEPENDING 0 
XN IBTBS VALUE'/1X, • IOD = ’,12,' — > OUTPUT UNIT IN STEP5, FORMAT 
XT ED MAGNETIC FIELD IN DESIRED SPACECRAFT COORDINATES'/IX, ' IOB = • 
X, 12, ' — > OUTPUT UNIT IN STEP5, BINARY MAGNETIC FIELD IN PROGRAM 
XFIT FORMAT'/IX, 'ISC1 = ',12,' --> FILTER SCRATCH UNIT'/IX, ’ ISC2 = 
x ',12,' --> FILTER SCRATCH UNIT'/IX, 'ISC3 = ',12,' — > SCRATCH U 
XNIT USED IN SUBPROGRAM DPINFO TO STORE VARIOUS DATA PARAMETERS'//) 

WRITEC6 , 111 ) IOBS 

111 FORMATC IX, *<TREND-FIT INPUT FILE NUMBER>'//1X, 'IOBS = ',12,' — > 
XINPUT UNIT IN FILTER, CONTAINS KNOTS, A PRIORI FREQUENCIES, AND OB 
XSERVATION SIGMAS FOR EACH FIELD COMPONENT'//) 

WRITEC6 , 112) DXOL , DYOL , DZOL , DBOL , XWINDO, YWINDO,ZWINDO, BWINDO, 
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XABVLAT , TRNL AT , ITMGAP 

112 FORMATUX, '<OUTLIER LIMIT INFORMATION> ’//IX, f DXOL = *,F8.2,' --> 
X MAGNITUDE TOLERANCE FOR RESIDUAL TOPOCENTRIC X COMPONENT CNT)'/1 
XX, ’ DYOL = ',F8.2,' — > MAGNITUDE TOLERANCE FOR RESIDUAL TOPOCEN 
XTRIC Y COMPONENT ( NT) '/IX, • DZOL = *,F8.2,' --> MAGNITUDE TOLERA 
XNCE FOR RESIDUAL TOPOCENTRIC Z COMPONENT CNT) ’/IX, »DBOL = »,F8.2 
x,' — > MAGNITUDE TOLERANCE FOR RESIDUAL TOPOCENTRIC B COMPONENT ( 
XNT) '/IX, 'XMINDO = ' , F8 . 2, * --> MAGNETIC LATITUDE TOLERANCE FOR FI 
XT/MAGSAT X COMPONENT '/IX, 'YWINDO = ',F8.2,' — > MAGNETIC LATITUDE 
X TOLERANCE FOR FIT/MAGSAT Y COMPONENT ’/IX, 'ZWINDO = »,F8.2,’ — > 
XMAGNETIC LATITUDE TOLERANCE FOR FIT/MAGSAT Z COMPONENT '/IX, ' BWINDO 
x = ' , F8 . 2, * --> MAGNETIC LATITUDE TOLERANCE FOR FIT/MAGSAT B COMP 
XONENT'/IX, 'ABVLAT = ',F8.2,* --> FILTER GEOCENTRIC LATITUDE TOLER 
XANCE FOR ALL COMPONENTS '/IX, f TRNLAT = ',F8.2,' --> GEODETIC LATIT 
XUDE ABOVE WHICH SATELLITE VELOCITY DIRECTION IS INDETERMINABL E ' / IX 
X, 'ITMGAP = ',18,' — > TIME-GAP TOLERANCE INCREMENT FOR DATA (SECO 
*NDS) '// ) 

IFC C IMODE. EO . 0) .OR. C IMODE. EQ . 3) ) WRITEC6,113) JJ,MM,NMX,NEXT, IOCF, 
XIDST , DST , LL 

113 FORMAT! IX, ’<INPUT MAGNETIC FIELD PARAMETERS>'//1X, * J J = ',17,' - 

*-> FID INPUT POSITION COORDINATES.- (0) GEODETIC Cl) GEOCENTRIC' 
*/lX, *MM = ',17,' --> FID EQU. RADIUS AND RCP. FLATTENING: (0) 

XDEFAULT AE = 6378.16 KM, FLAT = 298.25 Cl) INPUT VALUES'/1X, *NMX 
x = ’,17,' --> MAXIMUM DEGREE OF FID MODEL EVALUATION'/IX, 'NEXT = 
*’ , 17 , ' --> EXTERNAL FIELD MODEL: CO) DO NOT EVALUATE Cl) EVALUA 

XTE'/1X, 'IOCF = ',17,' — > INPUT UNIT IN FID FOR COMPUTED MAGNETIC 
x FIELD MODEL '/IX, 'IDST = *,I7,' --> INDUCED FIELD COEFFICIENTS: 
*C0) DO NOT EVALUATE Cl) EVALUATE'/IX, 'DST = ’,F7.2,' --> DST VA 
XLUE'/IX, 'LL = ',17,' --> FID FIELD EVALUATION MODE: C~l) EVALU 

XATE AT OLD TIME CO) EVALUATE Cl) READ FIELD MODEL AND EVALUATE'/ 
x/) 

IFCIM0DE.NE.2) WRITEC6 , 119 ) C EUC IK) , QI C IK) , QFCIK) ,CFCIK) , IK=1 , 3) , 
*( (CAC IK, I J ) , I J=1 , 3) , C RFC IK, IL) , IL=1 , 3) , CRCC IK, IM) , IM=1 , 3) , IK=1 , 3) 

114 FORMAT! IX, ^TRANSFORMATION INF0RMATI0N>'//1X, 'EU --> FIT EULER AN 
XGLES CDEGREES) '/IX, 'QI --> GSFC NOMINAL BIAS CORRECTIONS IN ORIGI 
XNAL SATELLITE COORDINATES CNT)'/1X,'QF — > FIT MAGNETOMETER BIAS 
XADJUSTMENTS CNT)'/1X,'CF --> FIT CALIBRATION SLOPE ADJUSTMENT MAT 
XRIX'/IX, 'CA — > CALIBRATION MATRIX IN ORIGINAL SATELLITE COORDINA 
XTES'/1X,'RF --> ROTATION MATRIX FROM ORIGINAL SATELLITE TO FIT/MA 
XGSAT COORDINATES '/IX, 'RC --> ROTATION MATRIX FROM FIT/MAGSAT TO D 
XESIRED SATELLITE COORDINATES '///IX, • EU = ',F12.5,' QI = *,F12.5,' 
x QF = * , F12 . 5 , ' CF = ' , F12 . 5/2C6X, F12 .5, 3C7X, F12.5)/)/lX, 'CA = ' 
x,3CF12.5) , ' RF = ',3CF12.5),' RC = • ,3CF12.5)/2C6X,3CF12.5),2C7X 
x,3CF12.5))/)/) 

NBD=0 

10 NBD=NBD+1 

READCIOBS, 115,END=20) ( EKNOTSC IK, NBD) , FREQCIK,NBD) , SIGC IK,NBD) , 
*IK=1,3) 

115 FORMAT! 3CF7 .2,F7.4,F7.3)) 

GO TO 10 

20 IFC C IMODE. EQ . 1 ) . OR . C IMODE. EQ .2) ) GO TO 30 
CALL STEP1 
CALL STEP2 
CALL STEP3 

30 DO 40 INTADD=1 , NEXTIN 
CALL STEP4(X60,X50) 

60 IFC C IMODE. EQ . 2) . OR . C IMODE. EQ . 3) ) GO TO 50 
CALL STEP5 
I0F1ST=0 
IOD1ST=0 
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50 IOW1ST = 0 
40 INTRVL = INTRVL +1 
STOP 
END 

BLOCK DATA 
INTEGER H( 3) 

DIMENSION EU(3),CA(3,3),QI(3),QF(3),CF(3),RF(3,3),RC(3,3),NN(3) 
DIMENSION NT(3),KA(3), ITERMXC3) , LGRMAX(3) , EPS(3) ,K0(3) , SIG(3, 500) 
DIMENSION EKNOTS( 3, 500 ) , FREQ( 3, 500 ) 

COMMON /STFILE/ IST1 , IST2, IST3, IST4 

COMMON /MDFILE/ IOR, IOW, IOF, IOD, IOB, IOF1ST, IOD1ST, I ONI ST, IOWIOF 
COMMON /SCFILE/ ISC1 , ISC2, ISC3 

COMMON /ARCLIM/ I ARC, IYRBEG, IDYBEG, ISCBEG, IYREND, IDYEND, ISCEND, 

* IFORM,NDATAR, INPUTF 

COMMON /I FI ELD/ JJ , MM, NMX, NEXT, IOCF, IDST, DST, LL 

COMMON /SPLINE/ H, NN, NT, KA, ITERMX, LGRMAX, EPS, KO, SIG, EKNOTS, FREQ 
COMMON /COTRAN/ EU,CA,QI,QF,CF,RF,RC 
COMMON /EPHEMS/ ORBINC, ERAD, IEPDAY, INCREM, INTRVL 
COMMON /FILTOP/ IMETH, ISPEC, IBTBS, SIGMLT, NFLAGK 

COMMON /LIMITS/ DXOL , DYOL , DZOL , DBOL , XNINDO, YWINDO,ZWINDO, BWINDO , 

* ABVLAT , TRNLAT , ITMGAP 

DATA IST1 , IST2, IST3, IST4, IOR, IOW, I OF, IOD, IOB, ISC1, ISC2, ISC3 

* /10, 11, 12, 13, 13, 14,15,16, 17, 18, 19, 20/ 

DATA I ARC, IYRBEG, IDYBEG, ISCBEG, IYREND, IDYEND, ISCEND, IFORM, NDATAR, 

* INPUTF, IOF1ST,IOD1ST,IOW1ST, IOWIOF /8*0, 5*1,0/ 

DATA JJ, MM, NMX, NEXT, IOCF, IDST, DST, LL /I , 0 , 14, 0, 21 , 0, 0 . 0 , 1/ 

DATA H , NN , NT , KA , I TERMX , L GRMAX, EPS , KO , SIG , EKNOTS , FREQ /3*0 , 3*4 , 6 *0 , 

* 3*20,3*10,3*0.01,3*0,4500*0.0/ 

DATA EU,QI,QF,CF,CA,RF,RC /9*0 . 0 ,4*1 . 0 , 3*0 . 0, 1 . 0, 3*0 . 0,2*1 . 0 , 

* 3*0. 0,1.0, 3*0.0, 2*1 . 0 , 3*0 .0,1.0, 3*0 .0,1.0/ 

DATA ERAD, IMETH, ISPEC, IBTBS, SIGMLT, NFLAGK /6371 . 2, 3, 0, 1 , 2 . 0, 0/ 

DATA DXOL , DYOL , DZOL , DBOL ,XWIND0, YWINDO.ZWINDO, BWINDO, ABVLAT , 

* TRNLAT, ITMGAP /2*1 0000 . 0 , 2000 . 0 , 10000 . 0, 50 . 0, 90 . 0, 2*50 . 0 , 

* 75.0,80.0,60/ 

END 

SUBROUTINE STEP1 
C 

C SUBROUTINE TO READ ORIGINAL SATELLITE MAGNETIC DATA TAPE AND TRANSFORM 
C RAW MAGNETOMETER COUNTS TO MAGNETIC FIELD VALUES IN THE SPACECRAFT 
C COORDINATE SYSTEM, AND ALSO PROCESS EPHEMERIS INFORMATION 
C 

C DATA DESCRIPTION FOR UNIT IST1 INPUT TAPE(S) 

C 

C IYR 

C IDAY 

C IETIME = 

C IALT = 

C GLAT = 

C GLON = 

C GMLAT = 

C GMLON = 

C XMLT 

C NS = 

C IDSEC = 

C JD 

C 
C 
C 

CHARACTER*24 FMT 

DIMENSION JD(3,20),EU(3),CA(3,3),QI(3),QF(3),CF(3),RF(3,3),RC(3,3) 


YEAR - 1900 

DAY NUMBER (JAN FIRST = 1) 

TIME OF EPHEMERIS RECORD (SEC U.T.) 

ALTITUDE (NAUTICAL MILES) 

GEOGRAPHIC LATITUDE 
GEOGRAPHIC LONGITUDE 
CORRECTED GEOMAGNETIC LATITUDE 
CORRECTED GEOMAGNETIC LONGITUDE 
CORRECTED GEOMAGNETIC LOCAL TIME 

NUMBER OF DATA RECORDS FOLLOWING EPHEMERIS RECORD 
TIME OF DATA RECORD (SEC U.T.) 

RAW MAGNETOMETER COUNTS: 

OLD TAPE FORMAT — > 2 SAMPLES/SECOND, 3 AXES/SAMPLE 
NEW TAPE FORMAT — > 20 SAMPLES/SECOND, 3 AXES/SAMPLE 
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REALX8 TBEG, TEND, TCUR, DAYDIV 
COMMON /STFILE/ IST1 , IST2, IST3, IST4 

COMMON /ARCLIM/ IARC, IYRBEG, IDYBEG, ISCBEG, IYREND, IDYEND, ISCEND, 
x IFORM, NDATAR, INPUTF 

COMMON /COTRAN/ EU, CA, QI , QF, CF, RF, RC 
C 

C COMPUTE BEGIN (TBEG) AND END (TEND) YEAR TIME OF SATELLITE ARC TO BE 
C PROCESSED, ACCOUNTING FOR LEAP YEARS 
C 

DAYDIV=365 . DO 

IF(MOD( IYRBEG, A) . EO . 0) DAYDIV =36 6 . DO 

TBEG=DBLE( IYRBEG)+(DBLE( IDYBEG)+(DBLE( ISCBEG)/S6400 . DO) )/DAYDIV 
DAYDIV=365 . DO 

IF(MOD( IYREND, A) .E0.0) DAYDIV=366 .DO 

TEND=DBLE( IYREND)+( DBLE(IDYEND)+(DBLEC ISCEND)/86A00 . DO ) )/DAYDIV 
C 

C DETERMINE THE FORMAT (FMT) OF THE INPUT TAPE(S): 

C IF IFORM = 0, USE OLD TAPE FORMAT — > 2 SAMPLES/SECOND, 3 AXES/SAMPLE 
C IF IFORM = 1, USE NEW TAPE FORMAT — > 20 SAMPLES/SECOND, 3 AXES/SAMPLE 
C 

IF( IFORM. EQ.O) FMT= * ( 416 , 52X, 5F10 . 2, 14) ' 

IF( IFORM. EQ.l) FMT =, (2IA,I6,IA,5F10.0,3X,IA)' 

C 

C COUNTER DEFINITIONS: 

C 

C NFREAD COUNTS NUMBER OF INPUT FILES THAT HAVE BEEN READ ON UNIT IST1 
C NEPHEM COUNTS NUMBER OF EMPHEMERIS RECORDS READ 
C NDRECT COUNTS TOTAL NUMBER OF DATA RECORDS READ 
C NDRECP COUNTS NUMBER OF DATA RECORDS ELIGIBLE FOR PROCESSING 
C NDRECA COUNTS NUMBER OF DATA RECORDS ACTUALLY PROCESSED WITHIN ARC 
C 

NFREAD=1 
NEPHEM=0 
NDRECT=0 
NDRECP=0 
NDRECA =0 
C 

C READ INPUT DATA FROM AN INPUTF NUMBER OF ORIGINAL TAPES ON UNIT IST1 

C 

10 READ(IST1 , FMT, END=30 ) IYR, IDAY, IETIME, IALT,GLAT,GLON,GMLAT,GMLON, 
XXMLT , NS 
NEPHEM=NEPHEM+1 
C 

C COMPUTE CURRENT YEAR TIME (TCUR) FOR THIS DATA POINT, ACCOUNTING FOR 
C LEAP YEARS 
C 

DAYDIV=365 . DO 

IF(M0D( IYR, A) . EQ.O) DAYDIV=366 . DO 

TCUR=DBLE( IYR)+( DBLE( IDAY)+( DBLE( IETIME)/86400 . DO ))/ DAYDIV 

C 

C CONVERT ALTITUDE FROM NAUTICAL MILES TO KM 
C 

ALT=REAL(IALT)xl.853 

C 

C READ RAW MAGNETOMETER DATA FOR EACH TIME INCREMENT IN SPACECRAFT 
C COORDINATES. IF IFORM = 0 OR 1, THEN USE OLD OR NEW TAPE FORMAT, 

C RESPECTIVELY 
C 

IUTFLG=0 
DO 20 1=1, NS 
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IFCIFORM. EQ . 0) READ( IST1 , 100 , END=30 ) IDSEC, C C JDCMM, NN) , NN=1 , 20 ) , 
XMM=1,3) 

IFCIFORM. EQ.l) READC ISTI ,101, END=30) IDSEC, ( (JDCMM, NN) ,MM=1 , 3) , 
XNN=1,2) 

100 FORMAT (16, AX, 2016/ 10X, 2016/ 10X, 2016) 

101 FORMAT ( 16 , 5X, 316 , AX, 316 , AX) 

C 

C PROCESS FIRST NDATAR DATA RECORD AFTER EMPHEMERIS RECORD ONLY IF 
C UNIVERSAL TIME OF FIRST DATA RECORD AND EPHEMERIS RECORD MATCH, THAT 
C IS, IUTFLG = 0 
C 

NDRECT=NDRECT+1 

IFC I. GT. NDATAR) GO TO 20 

IFC Cl. EQ.l) .AND. (IETIME.NE. IDSEC)) IUTFLG=1 
IFC IUTFLG .EQ.l) GO TO 20 
NDRECP=NDRECP+1 
C 

C IF IARC = 0, THEN PROCESS ENTIRE SATELLITE ARC TAPE 

C IF IARC = 1, THEN PROCESS SATELLITE ARC BETWEEN TBEG AND TEND ONLY 

C 

IFCCIARC. EQ.l). AND.CCTCUR.LT. TBEG). OR. CTCUR.GT. TEND))) GO TO 20 
NDRECA=NDRECA+1 
C 

C TRANSFORM RAW SATELLITE MAGNETOMETER COUNTS INTO MAGNETIC FIELD 
C COMPONENTS IN FIT CMAGSAT) SPACECRAFT COORDINATES BY PERFORMING: 

C 

C BS=RE*CF*CRF*CCA*M+QI)-QF) 

C 

C WHERE BS = MAGNETIC FIELD COMPONENTS IN FIT SPACECRAFT COORDINATES 

C RE = EULER ANGLE ADJUSTMENT MATRIX IN 1-3-2 ROTATION SYSTEM 

C CF = FIT CALIBRATION SLOPE ADJUSTMENT MATRIX 

C RF = ROTATION MATRIX FROM M TO BS COORDINATE SYSTEM 

C CA = CALIBRATION MATRIX IN ORIGINAL SPACECRAFT COORDINATES 

M = RAW MAGNETOMETER COUNTS IN ORIGINAL SPACECRAFT COORDINATES 
QI = GSFC NOMINAL BIAS CORRECTIONS 
QF = FIT MAGNETOMETER BIAS ADJUSTMENTS 

BS = C BX, BY, BZ) WHERE BX, BY, AND BZ ARE THE FIT/MAGS AT SPACECRAFT 
COMPONENTS (CROSS-TRACK, RADIAL , ALONG-TRACK) 

M = CXM, YM, ZM) WHERE XM, YM, AND ZM ARE THE ORIGINAL SPACECRAFT 
MAGNETOMETER COMPONENTS 

XM= JDC 1,1) 

YM=JD(2,1) 

ZM=JD(3, 1 ) 

PERFORM: P=CA*M+QI 

PX=CAC1,1)*XM+CAC1,2)*YM+CAC1,3)*ZM+QIC1) 
PY=CAC2,1)*XM+CAC2,2)*YM+CAC2,3)*ZM+QIC2) 

PZ=CAC3, 1)XXM+CA(3,2)*YM+CAC3,3)*ZM+QI(3) 

PERFORM: S=RF*P 

SX=RF( 1 , 1 )*PX+RF( 1 , 2)*PY+RFC 1 , 3)*PZ 
SY=RF(2,1)*PX+RF(2,2)*PY+RFC2,3)*PZ 
SZ=RF(3,1)*PX+RFC3,2)*PY+RFC3,3)XPZ 

PERFORM: W=CFx( S-QF) 
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c 

WX=(SX-QF(1))/CF(1) 

WY=CSY-QF(2))/CFC2) 

WZ=(SZ-QF(3))/CF(3) 

C 

C PERFORM: BS~RE*H 

C 

CALL EULER(WX,WY,WZ,BX,BY,BZ) 

WRITE EPHEMERIS AND MAGNETIC FIELD INFORMATION TO STORAGE UNIT IST2 

WRITE(IST2,102) IYR, I DAY , IDSEC, ALT, GLAT,GLON,GMLAT,GMLON, BX, BY, BZ 

102 F0RMAT(I2, 14, 16 , 5F7 .2, 3F8 . 1 ) 

20 CONTINUE 

GO TO 10 

FILE NUMBER NFREAD ON UNIT IST1 HAS JUST BEEN READ, COMPARE CURRENT 
NUMBER OF FILES READ (NFREAD) WITH TOTAL NUMBER OF FILES TO BE READ 
( INPUTF) . IF ALL INPUT FILES HAVE BEEN READ, THEN RETURN TO FILTER. 

IF ADDITIONAL INPUT FILES HAVE NOT BEEN READ, THEN READ NEXT FILE 

30 IFCNFREAD.EQ. INPUTF) GO TO 40 

RECORD NUMBER OF NEXT FILE TO BE READ 

NFREAD=NFREAD+1 
GO TO 10 

DETERMINE TOTAL NUMBER OF RECORDS (NTOTR) READ ON UNIT IST1 
40 NTOTR=NEPHEM+NDRECT 

PRINT INPUT AND OUTPUT DATA SET INFORMATION FOR STEP1 

WRITE( 6 ,103) IST1 , NTOTR, NEPHEM, NDRECT , NDRECP , NDRECA, IST2, NDRECA 

103 FORMAT ( *1', * xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx'/l 

xx,'xxxx PRE-FILTER PROCESSING x*x* V1X, 'XXXXXX 
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx ’ /// IX , *<STEP1 PROCES 
XSING>'//1X, 'INPUT DATA TYPE: RAW MAGNETOMETER COUNTS ON UNIT ',12 

X//3X, 'TOTAL RECORDS READ = ', I5//5X, 'NUMBER OF EMPHEMERIS RECORDS 
XREAD = *,I5/5X, 'NUMBER OF DATA RECORDS READ = ', I5//7X, 'NUMBER OF 
XDATA RECORDS ACCEPTED FOR PROCESSING = ', I5//9X, 'NUMBER OF DATA RE 
XCORDS PROCESSED IN ARC SEGMENT = ', I5//1X, • OUTPUT DATA TYPE: MAGN 

XETIC FIELD COMPONENTS IN FIT/MAGSAT COORDINATES ON UNIT ',I2//3X,' 
XTOTAL RECORDS WRITTEN = *,I5//) 

RETURN 
END 

SUBROUTINE EULERtWX, WY, WZ, BX, BY, BZ) 

C 

C SUBROUTINE TO PERFORM EULER ANGLE ADJUSTMENT ON TEMPORARY W VECTOR 
C WITH FULL ROTATION MATRIX: RE=R1XR3XR2 CORRESPONDING TO ROTATIONS 

C ABOUT EULER ANGLES EU(1), EU(3), AND EU(2), RESPECTIVELY 
C 

DIMENSION EU(3),CA(3,3),QI(3),0F(3),CF(3),RF(3,3),RC(3,3) 

COMMON /COTRAN/ EU, CA, QI , QF, CF, RF, RC 
C 

C DETERMINE DEGREES-TO-RADIANS CONVERSION 
C 

DTR=3. 1415926530/180.0 
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C ADJUST SIGNS OF ANGLES SUPPLIED BY PROGRAM FIT AND CONVERT TO RADIANS 
C 

EU1=-EU(1)*DTR 
EU2=-EU(2)XDTR 
EU3=EU( 3)*DTR 
C 

C DETERMINE NEEDED TRIGONOMETRIC FUNCTIONS OF THE EULER ANGLES 
C 

CE1=C05( EU1 ) 

SE1 =SIN( EU1 ) 

CE2=C0S( EU2) 

SE2=SIN( EU2) 

CE3=C0S( EU3) 

SE3=SIN( EU3) 

C 

C PERFORM: BS=RExW 

C 

BX=WXX(CE1XCE3)+WY*(CE1*SE3XCE2+SE1XSE2)+WZX(CE1XSE3XSE2-SE1XCE2) 

BY=WXX( -SE3 )+WYX(CE3*CE2)+WZ*( CE3XSE2 > 

BZ=WXX(SE1*CE3)+WYX(SE1XSE3XCE2-CE1XSE2)+WZX(SE1XSE3XSE2+CE1XCE2) 

RETURN 

END 

SUBROUTINE STEP2 
C 

C SUBROUTINE TO LOCATE AND PAD TIME GAPS IN THE DATA, AND DETERMINE THE 
C DIRECTION OF THE SPACECRAFT VELOCITY VECTOR 
C 

REAL *8 TIME,TIMEO 

COMMON /STFILE/ IST1 , IST2, IST3, IST4 

COMMON / LIMITS/ DXOL , DYOL , DZOL , DBOL, XWI NDO , YWINDO , ZWINDO , BNI NDO , 

X ABVLAT , TRNLAT , ITMGAP 

DATA IPASS /!/ , MDIRO /-!/ 

C 

C COUNTER DEFINITIONS: 

C 

C NTGAP COUNTS NUMBER OF PADDED TIME-GAP VALUES APPENDED TO OUTPUT DATA 
C NDASC COUNTS NUMBER OF ASCENDING POINTS 
C NDDSC COUNTS NUMBER OF DESCENDING POINTS 
C NDTRN COUNTS NUMBER OF TURNING POINTS 
C 

NTGAP=0 
NDASC- 0 
NDDSC=0 
NDTRN=0 
C 

C INITIALLY REWIND STORAGE UNIT IST2 CREATED IN SUBROUTINE STEPI 
C 

REWIND IST2 

READC IST2, 100) IYR, IDAYO, IETIMO 
C 

C CALL CLTIME WHEN FIRST POINT OF NEW PASS SEGMENT IS ENCOUNTERED 
C 

10 CALL CLTIMEC GLATO , TIMEO) 

20 READC IST2, 100, END=99) IYR, IDAY, IETIME, ALT, GLAT, GLON, GMLAT,GMLON, 
XBX, BY , BZ 

100 FORMAT (12, 14, 16, 5 F7 .2,3F8,1) 

C 

C AFTER READING NEXT DATA POINT ON UNIT IST2, DETERMINE ITS UNIVERSAL 
C TIME AND COMPARE WITH UNIVERSAL TIME OF PREVIOUS POINT. IF TIME 
C DIFFERENCE IS GREATER THAN ITMGAP SECONDS, THEN TIME GAP HAS OCCURRED 
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AND NEW PASS SEGMENT IS INITIALIZED BY CLTIME 
TIME=DBLE( IDAY)+DBLE( IETIME)/86A00 . DO 

IFCTIME-TIMEO . GT . ( DBLE( ITMGAP)+0 . 5D0 )/86400 . DO ) GO TO 10 
TIMEO=TIME 
C 

C CALCULATE DELTA LATITUDE OF PRESENT POINT. IF A TIME GAP PRESENTLY 
C EXISTS BETWEEN THE PRESENT AND PREVIOUS POINT, THEN USE A FORWARD 
C DIFFERENCE BETWEEN THE PRESENT AND FOLLOWING DATA POINT (CALCULATED 
C IN CLTIME), OTHERWISE, USE A BACKWARD DIFFERENCE. IF DELTA LATITUDE 
C IS NON-NEGATIVE, THEN SATELLITE IS CONSIDERED ASCENDING, IF NEGATIVE, 

C THEN DESCENDING. IF LATITUDE OF PRESENT POINT IS ABOVE +TRNLAT OR 
C BELOW -TRNLAT DEGREES LATITUDE, THEN VELOCITY DIRECTION CANNOT BE 
C ACCURATELY DETERMINED AND SATELLITE IS CONSIDERED TO BE TURNING (IDIR) 
C 

DELAT =GL AT-GLATO 
IF(DELAT.GE.O.O) IDIR=1 
IFCDELAT . GE . 0 . 0 ) MDIR=1 
IFCDELAT.LT. 0.0) IDIR=-1 
IFCDELAT.LT. 0.0) MDIR=-1 
IFCABSCGLAT) .GE. TRNLAT) IDIR=0 
C 

C IF SATELLITE DIRECTION CHANGES FROM DESCENDING TO ASCENDING (MDIR), 

C THEN NEW PASS HAS BEGUN. CALL PASDEN TO PROCESS PRESENT DATA POINT 
C WITHIN PROPER PASS 

C 

IFC CMDIRO . EQ . -1 ) .AND . CMDIR . EO . 1 ) ) IPASS=IPASS+1 
CALL PASDENCGLAT, ALT, IPASS, MDIR) 

C 

C CHECK FOR TIME GAPS BETWEEN PRESENT AND PREVIOUS POINT THAT OCCUR ON 
C SAME DAY 
C 

IFCIDAY . EQ . IDAYO) THEN 
ITIME=IETIME-IETIMO 

C 

c IF A TIME GAP OF GREATER THAN ITMGAP SECONDS IS FOUND, THEN DETERMINE 
C NUMBER OF ITMGAP SECOND PADS NEEDED AND WRITE THEM OUT TO UNIT IST3 AT 
C PROPER TIME INTERVALS. INOTE = 2 INDICATES A PADDED TIME GAP VALUE. 

C 

IFCITIME.GT. ITMGAP) THEN 
IN0TE=2 

IT=ITIME/ITMGAP-1 
DO 30 1=1, IT 
NTGAP=NTGAP+1 
ITIME=IETIMO+I*ITMGAP 
30 WRITEC IST3, 101) IYR, IDAY, ITIME, INOTE 

END IF 
C 

C CHECK FOR TIME GAPS BETWEEN PRESENT AND PREVIOUS POINT THAT OCCUR ON 
C DIFFERENT DAYS 
C 

ELSE 

ITIME=86AOO-IETIMO+IETIME 

C 

C IF A TIME GAP OF GREATER THAN ITMGAP SECONDS IS FOUND, THEN DETERMINE 
C NUMBER OF ITMGAP SECOND PADS NEEDED AND WRITE THEM OUT TO UNIT IST3 AT 
C PROPER TIME INTERVALS. INOTE = 2 INDICATES A PADDED TIME GAP VALUE. 

C 

IFCITIME.GT. ITMGAP) THEN 
IN0TE=2 
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IT=ITIME/ITMGAP-1 
IDAYC=IDAYO 
DO 40 1 = 1, IT 
NTGAP=NTGAP+1 
ITIME=IETIMO+lxlTMGAP 
IFCITIME.GE.86400) IDAYC=IDAY 
IFCITIME.GE. 86400) ITIME=ITIME-86400 
40 WRITE ( IST3, 101) IYR, IDAYC, ITIME, INOTE 
END IF 
END IF 
C 

C RESET DATA QUALITY FLAG INOTE = 0 INDICATING NO CONSTRAINTS ON DATA 
C 

INOTE=0 

C 

C IF VELOCITY DIRECTION IS INDETERMINABLE (IDIR = 0), THEN SET INOTE = 7 
C 

IFCIDIR.EQ.O) IN0TE=7 
C 

C WRITE OUT PRESENT DATA POINT EPHEMERIS, MAGNETIC FIELD, AND VELOCITY 
C VECTOR DIRECTION INFORMATION 
C 

IF(IDIR.EQ.l) NDASC=NDASC+1 
IF(IDIR.EQ.-l) NDDSC=NDDSC+1 
IF(IDIR.EQ.O) NDTRN=NDTRN+1 

WRITECIST3, 102) IYR, IDAY, IETIME, ALT,GLAT, GLON,GMLAT,GMLON, BX, BY, 
*BZ, IDIR, INOTE 
C 

C INITIALIZATION FOR PROCESSING NEXT DATA POINT. SET PRESENT DATA POINT 
C PARAMETERS TO PREVIOUS DATA POINT PARAMETERS 
C 

MDIRO=MDIR 
GLATO=GLAT 
IDAYO=IDAY 
IETIMO=IETIME 
GO TO 20 
C 

C END OF FILE ON UNIT IST2, CALL PASDEN AT PASEND ENTRY POINT TO 
C COMPLETE DATA DISTRIBUTION PLOTS 
C 

99 CALL PASEND 
C 

C DETERMINE TOTAL NUMBER OF RECORDS (NTOTR) READ ON UNIT IST2 
C DETERMINE TOTAL NUMBER OF RECORDS (NTOTW) WRITTEN ON UNIT IST3 
C 

NTOTR=NDASC+NDDSC+NDTRN 

NTOTW=NTOTR+NTGAP 

C 

C PRINT INPUT AND OUTPUT DATA SET INFORMATION FOR STEP2 
C 

WRITEC6 , 103) IST2, NTOTR, IST3, NTOTW, NDASC,NDDSC,NDTRN,NTGAP 
103 F0RMAT(//1X, *<STEP2 PROCESSING> V/1X, • INPUT DATA TYPE: MAGNETIC F 

XIELD COMPONENTS IN FIT/MAGSAT COORDINATES ON UNIT ', I2//3X, ‘TOTAL 
^RECORDS READ = * , I5//1X, ' OUTPUT DATA TYPE: SAME AS INPUT WITH VEL 

XOCITY DIRECTIONS AND PADDED TIME-GAP INFORMATION APPENDED ON UNIT 
x* , I2//3X, 'TOTAL RECORDS WRITTEN = ', I5//5X, 'NUMBER OF ASCENDING PO 
XINTS = ' , I5/5X, 'NUMBER OF DESCENDING POINTS = ’, IS^SX, 'NUMBER OF T 
XURNING POINTS = ', I5/5X, ’ NUMBER OF TIME-GAP POINTS = ',15//) 

101 FORMAT (12, 14, 16, 6 4X, 15) 

102 FORMAT (12,14,16, 5F7 . 2, 3F8 .1,215) 
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RETURN 

END 

SUBROUTINE CLTIME(GLATO, TIMEO) 

C 

C DETERMINES THE TIME AND DELTA LATITUDE OF THE PRESENT RECORD 
C THIS ROUTINE IS CALLED FOR INITIAL STARTS AND WHEN TIME GAPS ARE 
C ENCOUNTERED IN THE DATA 
C 

REALX8 TIMEO 

COMMON /STFILE/ IST1 , IST2, IST3, IST4 
BACKSPACE IST2 

READt I ST2 , 1 00 , END=99 ) IYR, I DAYO , I ETIMO , ALT , GL ATO 
READCIST2,100,END=99) IYR, IDAY, IETIM, ALT, GLAT 

100 FORMAT ( 12, IA, I6,5F7.2,3F8.1) 

BACKSPACE IST2 

BACKSPACE IST2 
C 

C DETERMINE DELTA LATITUDE BY FORWARD DIFFERENCE, THEN ADJUST PRESENT 
C DATA POINT LATITUDE GLATO SO THAT PROPER DELTA SIGN WILL BE DETERMINED 
C IN SUBROUTINE STEP2 

C 

DELAT =GLAT -GLATO 

IFCDELAT.GE. 0 . 0) GLATO=GLATO-l . 0 
IF(DELAT.LT.O.O) GLATO=GLATO+I . 0 
TIMEO=DBLEC IDAYO)+DBLE( IETIM0)/86400 . DO 
RETURN 

99 MRITE(6,101) 

101 F0RMAT(/1X, ***** END OF FILE IN SUBROUTINE CLTIME ****») 

STOP 

END 

SUBROUTINE PASDENCALAT, ALT, IPASS,MDIR) 

C 

C THIS SUBROUTINE PLOTS THE DISTRIBUTION OF DATA POINTS BY PASS, AND 
C ALSO CALCULATES AVERAGE ALTIUDE AND NUMBER OF POINTS PER PASS 
C 

CHARACTER*! P1C73) /73** •/, STAR /**’/, BLANK /• »/ 

LOGICAL FIRST /.TRUE./, PRINT 
DATA ALTSUM /0.0/, NUM /0/, ICNT /0/ 

C 

C ON FIRST CALL SETUP THE PLOT HEADING 
C 

IFCFIRST) THEN 
FIRST=. FALSE. 

IPOLD=IPASS 
WRITEC 6 , 100) 

WRITEC6, 101) 

END IF 

10 IFdPOLD. EQ . IPASS) THEN 
C 

C IF PRESENT DATA POINT BELONGS TO CURRENT PASS THEN CALCULATE 
C RELATIVE POSITION IN PI ARRAY (5 POINTS/ARRAY ELEMENT) DEPENDING UPON 
C VELOCITY DIRECTION. ALSO CONTINUE POINT COUNT AND ALTITUDE SUMMATION 
C 

IFCMDIR . EQ . 1 ) THEN 
LAT=INT((ALAT+92.5)/5.0)+l 
ELSE 

LAT=INT( (92 . 5-ALATV5 . 0)+37 
END IF 

P1(LAT)=STAR 

NUM=NUM+1 
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ALTSUM=ALTSUM+ALT 
PRINT = . TRUE . 

ELSE 

C 

C IF PRESENT DATA POINT BELONGS TO A SUCCEEDING PASS THEN CALCULATE 
C AVERAGE ALTITUDE FOR LAST PASS AND PRINT LAST PASS INFORMATION 
C 

AVGALT =ALTSUM/REAL ( NUM) 

WRITEC6 ,102) IPOLD, PI, NUM, AVGALT 
PRINT=. FALSE. 

ICNT=ICNT+1 

IF MORE THAN 50 PASSES HAVE BEEN PRINTED ON ONE PAGE, THEN SKIP PAGE 

IFtMODC ICNT , 50 ) . EQ . 0 ) THEN 
WRITE(6 , 101 ) 

WRITE(6 , 100 ) 

WRITEC6 , 101) 

END IF 

CLEAR PI ARRAY AND RESET VARIABLES TO BEGIN PROCESSING NEW PASS 

DO 20 1=1,73 
20 PI ( I ) =BLANK 
NUM=0 

ALTSUM=0 . 0 
IPOLD=IPASS 
GO TO 10 
END IF 
RETURN 

ENTRY POINT AFTER LAST PASS ON DATA TAPE, PRINT LAST PASS INFORMATION 
ENTRY PASEND 

IF(NUM.NE.O) AVGALT =ALTSUM/REAL C NUM) 

IF(PRINT) WRITEC 6 ,102) IPOLD, PI , NUM, AVGALT 
IF(PRINT) WRITE( 6 , 101 ) 

RETURN 

100 FORMAT( *1’ , ^SATELLITE-PASS DENSITY DISTRIBUTIONS> *//A2X, 'TIME 

x>’ , 10X, * C 5 DEGREES PER X)') 

101 F0RMAT(/1X, ’PASS# -9 -7 -6 -A -3 -1 0 1 3 A 6 7 9 7 6 

X A 3 1 0 -1 -3 -A -6 -7 -9 < LAT tPOINTS AVG ALT’/l 

*2X,’0 50505050505050505050 

X 5 0 5 0’/) 

102 FORMAT (1X,I5,6X»73A1,18X,IA,2X,F9.2) 

END 

SUBROUTINE STEP3 
C 

C SUBROUTINE TO TRANSFORM MAGNETIC FIELD MEASUREMENTS FROM SPACECRAFT 
C TO TOPOCENTRIC COORDINATE SYSTEM, COMPUTE FIELD VALUES FROM INPUT 
C MODEL, AND DETERMINE FIELD RESIDUALS (OBSERVED MINUS COMPUTED). FLAG 
C DATA POINTS WHOSE RESIDUALS ARE GREATER THAN A SPECIFIED TOLERANCE 
C 

REALX8 COSLAT , SI NALP , COSALP , SINDEL , SADCL , CAMSD, DTR 

COMMON /STFILE/ IST1 , IST2, IST3, ISTA 

COMMON /I FI ELD/ J J , MM, NMX, NEXT , IOCF, IDST, DST , LL 

COMMON /EPHEMS/ ORBINC, ERAD, IEPDAY, INCREM, INTRVL 

COMMON /LIMITS/ DXOL , DYOL , DZOL , DBOL , XWINDO, YWINDO,ZWINDO , BWINDO, 

X ABVLAT , TRNLAT , ITMGAP 

C 
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C CALCULATE DEGREES-TO-RADIANS CONVERSION 
C 

DTR=3 . 14 15926 5300/ 180 . DO 
C 

C COUNTER DEFINITIONS: 

C 

C NTOTR COUNTS TOTAL RECORDS READ ON UNIT IST3 

C NTGAP COUNTS PADDED TIME-GAP POINTS NOT TRANSFORMED TO TOPOCENTRIC 
C NDTRN COUNTS SATELLITE TURNING POINTS NOT TRANSFORMED TO TOPOCENTRIC 
C NOUTX COUNTS NUMBER OF TOPOCENTRIC X GROSS-OUTLIERS 

C NOUTY COUNTS NUMBER OF TOPOCENTRIC Y GROSS-OUTLIERS 

C NOUTZ COUNTS NUMBER OF TOPOCENTRIC Z GROSS-OUTLIERS 

C NOUTB COUNTS NUMBER OF TOPOCENTRIC B GROSS-OUTLIERS 

NTOTW COUNTS TOTAL RECORDS WRITTEN ON UNIT IST4 

NTOTR=0 
NTGAP=0 
NDTRN=Q 
NOUTX=0 
NOUTY=0 
NOUTZ=0 
NOUTB=0 
NT0TW=0 

DETERMINE NEGATIVE COMPLEMENT ALPHA OF ORBIT INCLINATION ANGLE ORBINC 
ALPHA=ORBINC-90 . 0 

TRANSFER I FIELD COMMON PARAMETERS TO ARGUMENT LIST FOR SUBROUTINE FID 

J1=I0CF 
J2= J J 
J3=MM 
J4=NEXT 
J5=IDST 
J6=NMX 
J7 = LL 
PI =DST 

REWIND STORAGE UNIT IST3 AND BEGIN TO PROCESS DATA 
REWIND IST3 

10 READC IST3, 100 , END=60 ) IYR, IDAY, IETIME, ALT,GLAT,GLON,GMLAT,GMLON, 
*BX, BY, BZ, I DIR, I NOTE 
100 FORMAT (12,14,16, 5F7 . 2/ 3F8 ♦ 1 , 215) 

NTOTR=NTOTR+l 
C 

C IF DATA POINT IS A PADDED TIME-GAP VALUE, THEN SKIP PROCESSING 
C 

IF( INOTE. EQ . 2) GO TO 20 
C 

C COMPUTE GEOCENTRIC LATITUDE AND RADIUS 
C 

CALL GEOCEN(GLAT,GCLAT, ALT,CALT) 

C 

C TRANSFORM SPACECRAFT FIELD VECTOR INTO TOPOCENTRIC MAGNETIC FIELD 
C VECTOR BY PERFORMING: 

C 

C BT=TS*BS 

C 
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C WHERE BT = FIELD COMPONENTS IN CARTESIAN TOPOCENTRIC COORDINATES 
C TS = ROTATION MATRIX FROM SPACECRAFT TO TOPOCENTRIC COORDINATES 

C BS = MAGNETIC FIELD COMPONENTS IN FIT SPACECRAFT COORDINATES 

C 

C MATRIX TS HAS THE FOLLOWING FORM: 

C 

C TS = ( SIN( ALPHA )/COS(GCL AT ) 0 tCOSC ALPHA )*SINC DELTA) ) 

C C tCOS( ALPHA)*SIN( DELTA) 0 -SINC ALPHA)ZCOS(GCLAT) ) 

C ( 0 1 0 ) 

C 

C WHERE ALPHA = NEGATIVE COMPLEMENT OF ORBIT INCLINATION 

C GCLAT = GEOCENTRIC LATITUDE 

C DELTA = ARCOS ( TAN (GCLAT) *TAN( ALPHA ) ) 

C * = + FOR ASCENDING AND - FOR DESCENDING SATELLITE DATA 

C 

C BT = (TX,TY,TZ) WHERE TX, TY, AND TZ ARE THE CONVENTIONAL TOPOCENTRIC 
C COMPONENTS, THAT IS, (-BTHETA, BPHI, -BRHO) 

C 

C CALCULATE SCALAR FIELD VALUE IN TOPOCENTRIC COORDINATES 
C 

BB=SQRT( BX*BX+BY*BY+BZ*BZ) 

C 

C IF VELOCITY DIRECTION CANNOT BE DETERMINED, THEN SKIP PROCESSING 
C 

IF(IDIR.EQ.O) GO TO 30 

DETERMINE NEEDED TRIGONOMETRIC FUNCTIONS OF GCLAT, ALPHA, AND DELTA 

COSLAT=DCOS(DBLE( GCLAT )*DTR) 

SINALP=DSIN(DBLE(ALPHA)*DTR) 

COSALP=DCOS(DBLE(ALPHA)*DTR) 

SINDEL=DSIN( DACOS(DTAN( DBLEC GCLAT )*DTR)*DTAN(DBLE(ALPHA)XDTR) ) ) 
SADCL=SINAL P/COSLAT 
CAMSD=COSALP*SINDEL 
IF(IDIR.EQ.-l) GO TO 40 

PERFORM TRANSFORMATION IF SATELLITE IS ASCENDING 

TX=BX*SADCL+BZ*CAMSD 
TY=BX*CAMSD-BZ*SADCL 
GO TO 50 

PERFORM TRANSFORMATION IF SATELLITE IS DESCENDING 

40 TX=BX*SADCL-BZXCAMSD 
TY=-BX*CAMSD-BZ*SADCL 
50 TZ=BY 
C 

C CALCULATE SCALAR FIELD VALUE IN SPACECRAFT COORDINATES 
C 

TB=SQRT( TX*TX+TY*TY+TZ*TZ) 

C 

C DETERMINE TIME IN YEARS FOR CURRENT DATA POINT FOR INPUT TO FID 
C 

TM=1900.0+REALCIYR)+C REAL (IDAY) + ( REAL C IETIMEV86400 . 0) )/365 . 0 
C 

C DETERMINE THE COMPUTED FIELD VALUE FOR THIS POINT AT TIME TM USING THE 
C MODEL THAT IS INPUT ON UNIT IOCF 
C 

CALL FID(J1,J2,J3,J4,J5, GCLAT, GLON,CALT,TM, PI, J6,J7,CX,CY,CZ,CB) 
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c 

C CALCULATE RESIDUAL MAGNETIC FIELD VALUES 
C 

DX=TX-CX 

DY=TY-CY 

DZ=T2-CZ 

DB=TB-CB 

C 

C FLAG POINTS WHOSE RESIDUAL VALUES ARE GREATER THAN SPECIFIED VALUES 
C FOR ANY PARTICULAR COMPONENT, USING A FLAG OF INOTE = 1. WRITE 
C MAGNETIC FIELD AND EPHEMERIS INFORMATION TO UNIT ISTA 

C 

IF((ABS(DX) .GT.DXOL) .OR. (ABS(DY) .GT.DYOL) .OR. (ABSCDZ) .GT.DZOL) .OR. 
x(ABS(DB) . GT.DBOL)) INOTE=l 
IF(ABS(DX) .GT.DXOL) NOUTX=NOUTX+l 
IFtABS(DY) .GT.DYOL) NOUTY=NOUTY+l 
IF(ABS(DZ) .GT.DZOL) NOUTZ=NOUTZ+l 
IFtABS(DB) .GT.DBOL) NOUTB=NOUTB+l 
NTOTW=NTOTW+l 

WRITEC I ST A, 101) IYR, IDAY , IETIME,GLAT ,GCLAT,GLON,GMLAT,GMLON, ALT, 
KCALT , BX, BY, BZ, BB, TX,TY, TZ, TB, DX, DY, DZ, DB,CX,CY,CZ,CB, IDIR, INOTE 

101 FORMAT CI2,IA,I6,7F7.2,AF8.1, 32X, 12F8 . 1 , ZI5) 

GO TO 10 

C 

C IF PADDED TIME-GAP VALUES ARE ENCOUNTERED, THEN WRITE INFORMATION TO 
C UNIT ISTA USING A FLAG OF INOTE = 2 

C 

20 NTGAP=NTGAP+1 

WRITEC ISTA, 102) IYR, IDAY, IETIME, INOTE 

102 FORMAT (12, IA, 16, 21 AX, 15) 

GO TO 10 

C 

C IF VELOCITY DIRECTION CANNOT BE DETERMINED FOR THIS DATA POINT, THEN 
C WRITE SPACECRAFT FIELD VECTOR COMPONENTS ONLY TO UNIT ISTA 
C 

30 NDTRN=NDTRN+1 

WRITEt ISTA, 103) IYR, IDAY, IETIME, GLAT,GCLAT,GLON,GMLAT,GMLON, ALT, 
*CALT,BX, BY, BZ, BB, IDIR, INOTE 

103 FORMAT (I2,IA,I6,7F7 .2,AF8.1,128X,2I5) 

GO TO 10 

C 

C DETERMINE POINT TOTAL OMITTED (NOMIT) FROM TOPOCENTRIC TRANSFORMATION 
C DETERMINE POINT TOTAL FLAGGED (NFLAG) AS GROSS-OUTLIERS 
C 

60 NOMIT =NTGAP+NDTRN 

NFLAG=NOUTX+NOUTY+NOUTZ+NOUTB 

PRINT INPUT AND OUTPUT DATA SET INFORMATION FOR STEP3 

WRITE(6,10A) IST3, NTOTR , NOMIT , NTGAP , NDTRN , I STA , NTOTW, NFLAG, NOUTX, 
XNOUTY , NOUTZ, NOUTB 

10A F0RMATC//1X, *<STEP3 PROCESSING> V/1X, 'INPUT DATA TYPE: FIT/MAGSAT 

* FIELD COMPONENTS WITH APPENDED VELOCITY DIRECTION/TIME-GAP INFORM 
XATION ON UNIT ' , I2//3X, 'TOTAL RECORDS READ = • , IS/^SX, 'TOTAL RECOR 
*DS OMITTED FROM TOPOCENTRIC TRANSFORMATION = * , I5//7X, 'TIME-GAP OM 
MISSIONS = M5/7X, 'SATELLITE TURNING POINT OMISSIONS = ',I5//1X,'0 
XUTPUT DATA TYPE: MAGNETIC FIELD AND RESIDUALS IN TOPOCENTRIC COOR 

KDINATES ON UNIT ', I2//3X, 'TOTAL RECORDS WRITTEN = I5//5X, 'TOTAL 

XGROSS-OUTLIERS = ', I5//7X, 'TOPOCENTRIC X OUTLIERS = • , I5/7X, 'TOPOC 
XENTRIC Y OUTLIERS = ', I5/7X, 'TOPOCENTRIC Z OUTLIERS = *,I5/7X,»T0P 
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XOCENTRIC B OUTLIERS = ’,15//) 

RETURN 

END 

SUBROUTINE GEOCEN(GLAT ,GCLAT , ALT ,CALT) 

C 

C CONVERT GEODETIC LATITUDE (GLAT) AND ALTITUDE (ALT) TO GEOCENTRIC 
LATITUDE CGCLAT) AND RADIUS (CALT) 

IMPLICIT REALX8(A-H,0-Z) 

REALX4 GLAT, GCLAT, ALT, CALT 
DTR=3 . 141592653D0/180 . DO 

A = EQUITORIAL RADIUS, E = OPTICAL FLATTENING, BOA = RATIO OF POLAR TO 
EQUITORIAL RADII, AN = EAST-NEST RADIUS OF CURVATURE 

A=6378 . 16D0 
E=1 .DO/298. 25D0 
BOA=l .DO-E 

AN=A/DSQRT(DC0S(GLATXDTR)**2+CB0AXDSIN(GLAT*DTR))*X2) 

CALCULATE GCLAT AND CALT USING PYTHAGOREAN RELATIONSHIPS 
H=ALT 

T0P=(B0AXX2XAN+H)XDSINCGLATXDTR) 

BOT=(AN+H)XDCOS(GLAT*DTR) 

GCLAT =DATAN2(T0P , BOT )/DTR 
CALT=DSQRT( B0TX*2+T0PXX2) 

RETURN 
END 

SUBROUTINE TRANSFC PHIR, ALAMR, IDIR,RH,ANORM,VH) 

SUBROUTINE TO CREATE TRANSFORMATION MATRIX BETNEEN SPACECRAFT AND 
GEOCENTRIC COORDINATE SYSTEMS 

ORBINC = ANGLE OF ORBIT INCLINATION 

RH = SATELLITE POSITION VECTOR IN (X,Y,Z) COORDINATES 

ANORM = ORBIT NORMAL VECTOR IN (X,Y,Z) COORDINATES 
VH = SATELLITE VELOCITY VECTOR IN (X,Y,Z) COORDINATES 

PHIR = GEOCENTRIC LATITUDE OF POSITION VECTOR 

PHIN = GEOCENTRIC LATITUDE OF NORMAL VECTOR 

ALAMR = LONGITUDE OF POSITION VECTOR 
ALAMN = LONGITUDE OF NORMAL VECTOR 

IDIR = VELOCITY VECTOR DIRECTION: +1 — > ASCENDING 

0 — > TURN AROUND 
-1 --> DESCENDING 

IMPLICIT REALX8(A-H,0-Z) 

DIMENSION RH( 3) , ANORM( 3) , VH( 3) 

REALX4 ORBINC, ERAD 

COMMON /EPHEMS/ ORBINC, ERAD, IEPDAY, INCREM, INTRVL 
DTR=3 . 141 5926 54D0/ 180 . DO 

PHIN IS THE COMPLEMENT OF THE ANGLE OF INCLINATION 
PHIN=90 . DO-DBLEC ORBINC) 

INITIALIZE POSITION, NORMAJ., AND VELOCITY VECTORS FOR NEXT MATRIX 

DO 10 1=1,3 
RH( I )=0 . DO 
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ANORMC I )=0 . DO 
10 VHC I ) =0 . DO 

c 

C IF SATELLITE IS TURNING THEN ORBIT NORMAL CANNOT BE DETERMINE!) 
C 


IF(IDIR.NE.O) GO TO 20 
WRITEC6 , 100) PHIR, ALAMR 

100 F0RMATC/1X, 'ATTENTION: CANNOT FIND ORBIT NORMAL VECTOR FOR TURNIN 

KG POINT AT LATITUDE: ',F7.2,« LONGITUDE: ',F7.2) 

RETURN 

C 

C CALCULATE LONGITUDE DIFFERENCE BETWEEN POSITION AND NORMAL VECTORS 
C DETERMINE WHICH QUADRANT NORMAL LONGITUDE LIES IN 
C 

20 ANGLE=DARCOS(-DTAN(PHIRXDTR)XDTAN(PHINXDTR))/DTR 
IFCIDIR.EQ. 1) ALAMN=ALAMR-ANGLE 
IF(IDIR.EQ.-l) ALAMN=ALAMR+ ANGLE 

C 

C TRANSFORMATION FROM SPHERICAL TO CARTESIAN COORDINATES FOR POSITION 
C AND NORMAL VECTORS 
C 

RHC1)=DC0S(PHIRXDTR)XDC0S(ALAMRXDTR) 

RHC2)=DC0SCPHIRXDTR)XDSIN(ALAMRXDTR) 

RHC3)=DSINCPHIRXDTR) 

ANORMC 1 ) =DCOS( PHINxDTR) xDCOSC ALAMNXDTR) 

ANORMC 2) =DCOSCPHINXDTR)XDSINCALAMNXDTR) 

ANORMC3)=DSIN(PHINXDTR) 

c 

C DETERMINE VELOCITY VECTOR FROM CROSS PRODUCT OF POSTION AND NORMAL 
C VECTORS: CANORM X RH) = VH 

C 


VH 1 1 ) = ANORMC 2 ) XRH C 3 ) -RH ( 2 ) XANORMC 3 ) 

VH C 2 ) =ANORM C 3 ) XRH C 1 ) -RH C 3 ) XANORMC 1 ) 
VHC3)=AN0RMC1)XRHC2)-RHC1)XAN0RMC2) 

RETURN 

END 

SUBROUTINE FID C IU, J ,MM, NEXT, IDST, DLAT, DLONG, Q1 , TM, DST, NMX, L,X, Y, 
XZ,F) 


CXXXXXXKXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXKXXKXXXKXKKXXXXXXXXXXKXXX 


c 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


FID INPUT PARAMETERS: 


J .EQ. 0 


J .NE. 0 


MM .EQ. 0 
MM .NE. 0 


INPUTS LATITUDE AND ALTITUDE CKM) RELATIVE TO 
ELLIPSOID CGEODETIC COORDINATES). OUTPUT FIELD 
COMPONENTS NORTH, EAST, VERTICAL IN GEODETIC 
COORDINATES 

INPUTS LATITUDE AND LONGITUDE IN GEOCENTRIC 
COORDINATES AND GEOCENTRIC RADIUS CKM). OUTPUT FIELD 
COMPONENTS NORTH, EAST, VERTICAL IN SPHERICAL 
COORDINATES 

USE DEFAULT VALUES AE=6378.16, FLAT=298.25 
INPUT VALUES FOR AE AND FLAT ON FIRST CALL TO FID 


NEXT .EQ. 0 DO NOT EVALUATE EXTERNAL FIELD MODEL, DO NOT READ 

INPUT VALUES FOR EXTERNAL FIELD PARAMETERS WHEN L IS 
GREATER THAN 0 

NEXT .NE. 0 EVALUATE EXTERNAL FIELD MODEL, READ INPUT VALUES FOR 
EXTERNAL FIELD PARAMETERS WHEN L IS GREATER THAN 0 
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c 


c 

IDST . 

EQ. 0 


DO NOT EVALUATE INDUCED COEFFICIENTS 


c 

IDST . 

EQ. 1 


EVALUATE INDUCED COEFFICIENTS 


L 

c 

DLAT 



GEODETIC LATITUDE IN DEGREES WHEN J = 0 


c 




GEOCENTRIC LATITUDE IN DEGREES WHEN J = 1 


L 

c 

DLONG 



LONGITUDE IN DEGREES 


L 

c 

Q1 



GEODETIC ALTITUDE CKM) WHEN J = 0 


c 




GEOCENTRIC RADIUS (KM) WHEN J = 1 


c 

c 

NMX 



MAXIMUM DEGREE OF MODEL EVALUATION 


L 

c 

DST 



DST VALUE 


c 

c 

NMAX 



MAXIMUM DEGREE AND ORDER OF CONSTANT FIELD TERMS 

c 

NMAXT 



MAXIMUM DEGREE AND ORDER OF FIRST ORDER TIME 

TERMS 

c 

NMAXTT 



MAXIMUM DEGREE AND ORDER OF SECOND ORDER TIME TERMS 

c 

NMXTTT 



MAXIMUM DEGREE AND ORDER OF THIRD ORDER TIME 

TERMS 

c 

c 

K .EQ. 

0 


FIELD MODEL COEFFICIENTS SCHMIDT NORMALIZED 


c 

K . NE . 

0 


FIELD MODEL COEFFICIENTS GAUSS NORMALIZED 


c 

c 

TZERO 



EPOCH TIME FOR FIELD MODEL COEFFICIENTS 


c 

c 

TM 



TIME OF PARTICULAR FIELD EVALUATION 


c 

c 

ABAR 



MEAN RADIUS USED IN FIELD MODEL POTENTIAL EXPANSION 

c 




(DEFAULT = 6371.2) 


c 

c 

MODEXT 

.EQ. 

0 

NO EXTERNAL FIELD SOLVED WITH MODEL 


c 

MODEXT 

.NE. 

0 

EXTERNAL FIELD SOLVED WITH MODEL 


c 

c 

MODIND 

.EQ. 

0 

NO INDUCED COEFFS SOLVED WITH MODEL 


c 

MODIND 

.NE. 

0 

INDUCED COEFFS SOLVED WITH MODEL 


c 

c 

L .EQ. 

0 


EVALUATE FIELD 


c 

L .GT. 

0 


READ IN FIELD MODEL AND EVALUATE FIELD 


c 

L . LT . 

0 


EVALUATE FIELD AT OLD TIME 



c 

c*********************************************************************** 

EQUIVALENCE ( SHMIT(1 , 1 ) , TG( 1 , 1 ) ) 

COMMON /COEFFS/TG( 31 , 31 ) 

COMMON/ INDUCE/ I IDST , AL FA1 , AL FA2, AL FA3 , AL FA4 , DSTT 
COMMON / FL DCOM/ ST , CT , SPH , CPH , R , NMAX , BT , BP , BR , B , 
&ABAR,E1,E2,E3,NEXTF,Q(5,5) 

DIMENSION G(31,31),GT(31,31),SHMIT(31,31),AID(33) 

DIMENSION GTTT (8,8), GTT (31,31) 

DATA IFRST/O/ 

DATA AE, FLAT/6378. 16, 298. 25/ 

DATA TLAST/O ./ 

DATA TABAR/6371 . 2/ 

IF(IFRST) 110,100,110 


C C 
C EQUATORIAL EARTH RADIUS AND FLATTENING FACTOR C 
C USED IN GEODETIC-GEOCENTRIC COORDINATES. C 
C c 
C THE MODEL ITSELF IS INDEPENDENT OF THOSE C 
C PARAMETERS C 
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C 


C 


100 IFCMM.NE. 0)READ(IU,101) AE, FLAT 

101 FORMAT ( IX, 2F6.1) 

WRITE(6,112) 

112 FORMAT ( '1', '<INPUT MAGNETIC FIELD MODEL INFORMATIONS ) 

WRITEC6 ,109) AE, FLAT 

109 F0RMATC//5X, 'CONSTANTS USED : •/, 22X, * EQUATORIAL EARTH RADIUS ', 
BF8.3/,22X, 'EARTH RECIPROCAL FLATTENING ',F6.1//) 

IFRST=1 

FLAT=1 . -1 ./FLAT 
El =0 . 

E2=0 . 

E3=0. 

ALFA1=0 • 

ALFA2=0. 

ALFA3=0 . 

ALFAA=0. 

A2=AE**2 
A4=AEX*4 
B2=CAE*FLAT)XX2 
A2B2=A2*( 1 . -FL AT**2) 

A4B4=A4X(1.-FLAT**4) 

110 IF (L) 19,1,2 

1 IF CTM-TLAST) 17,19,17 

2 READ (IU,3) NMAX,NMAXT,NMAXTT, NMXTTT, MODEXT,K,TZERO,ABAR,MODIND, 
&( AIDCI ) ,1=1,13) 

3 FORMAT (412, 21 2, 2F6. 1,12, 12A4, A2) 

IFCABAR.EQ.O . ) ABAR-TABAR 
READC IU, 103) CAID(I), 1=14,33) 

103 FORMAT (20A4) 

L = 0 

WRITE (6,104) (AIDCI), 1=1,33) 

104 FORMAT (25X, 12A4, A2/5X, 20A4// ) 

WRI T E ( 6 , 1 0 5 ) NMAX , NMAXT , NMAXTT , NMXTTT ,MODEXT,K, TZERO , ABAR , NEXT 
105 F0RMATC5X, 'FIELD MODEL ORDER C ' , 12, • , * , 12, 1 , * , 12, • , * , 12, • ) V , 

.5X, 'EXTERNAL FIELD SOLVED WITH MODEL ( O-NO; . GT . 0-DEGREE) ' , 12/, 
.5X, 'NORMALIZATION ( K=0-SCHMIDT ; K. NE. 0-GAUSS) ', 12/, 

.5X, 'FIELD MODEL EPOCH ',F6.1/, 

.5X, 'FIELD MODEL MEAN RADIUS ',F6.1/, 

.5X, 'EVALUATE EXTERNAL FIELD TO DEGREE' , 12//) 

MAXN=0 

TEMP=0. 

5 READ (IU,6) N , M , GNM , HNM , GTNM , HTNM , GTTNM , HTTNM 

6 FORMAT ( 213, 6F11 .A) 

N=NL + 1 
M=ML + 1 

IF (N.LE.O) G0T07 
MAXN= < MAXO ( N , MAXN ) ) 

G(N,M)=GNM 
GT(N,M)=GTNM 
GTT(N,M)=GTTNM 
TEMP=AMAX1 ( TEMP, ABSC GTNM) ) 

IF (M.EQ.l) G0T05 
GCM-l , N)=HNM 
GT(M-1, N)=HTNM 
GTT ( M-l , N ) =HTTNM 
GO TO 5 

7 IF( NMXTTT. EQ . 0) GO TO 107 

1 06 READC I U , 6 ) N , M, GTTTNM, HTTTNM 

IF(N.EQ.O) GO TO 107 
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107 

C 

30 

31 

102 

8 

9 

10 

11 

12 


32 

111 

108 

13 

19 


I F ( N . GT . 8 ) STOP 106 
GTTT C N , M) =GTTTNM 

IFCM. EQ.l) GO TO 106 
GTTT C M-l , N ) =HTTTNM 
GO TO 106 
CONTINUE 

READ EXTERNAL FIELD 

IFCMODEXT.NE.O) THEN 
READCIU,6) N,M,QNM,SNM 
IFCN .LE. 0) GO TO 31 
Q(N,M) = QNM 
IF(M .EQ. 1) GO TO 30 
QCM-1 , N) = SNM 
GO TO 30 
END IF 
CONTINUE 

IFCMODIND . NE . 0 . AND . IDST . NE . 0) READC IU, 102JALFA1 , ALFA2,ALFA3, 
ALFA9 

FORMAT C 6 X, 9 FI 1 . 9) 

WRITEC 6 , 8 ) 

FORMATC6HO N M, 6X, 1HG, 10X, 1HH, 9X, 2HGT , 9X, 2HHT,8X, 3HGTT , 

. 8X, 3HHTT, 7X, 9HGTTT, 7X, 9HHTTT// ) 

DO 12 N=2,MAXN 
DO 12 M=1,N 
MI=M-1 

IF (M.EQ.l) GOTOIO 

I F ( N . GT . NMXTTT ) WRITEC 6 , 9 )N,M, G( N, M) , GCMI , N) , 
.GTCN,M),GTCMI,N),GTT(N,M),GTTCMI,N) 

IFCN. LE. NMXTTT) WRITEC6 , 9 )N, M, GC N, M) , GCMI , N) , 
.GTCN,M),GTCMI,N),GTTCN,M),GTTCMI,N),GTTTCN,M),GTTTCMI,N) 

F0RMATC2I3>8F11 .9) 

GO TO 12 
CONTINUE 

IFCN.GT. NMXTTT) WRITEC6 , 11 )N,M, GCN,M) , GTCN,M) , 

&GTTCN, M) 

IFCN.LE. NMXTTT) WRITEC6 , 11 )N ,M, GC N,M) , GTC N,M) , 
&GTTCN,M),GTTTCN,M) 

FORMAT C2I3,F11.9,11X,F11.9,11X,F11.9,11X»F11.9) 

CONTINUE 

IFCMODEXT.NE.O) THEN 
WRITEC6 ,108) 

DO 32 N = 2,M0DEXT 
DO 32 M = 1,N 

IFCM .EQ. 1) SNM = 0.0 
IFCM .NE. 1) SNM = QCM-1, N) 

WRITEC6 , 6 ) N,M,QCN,M),SNM 
CONTINUE 
END IF 

IFCIDST.NE.O) WRITEC6 , 111) ALFA1 , ALFA2, ALFA3, ALFA9 
F0RMATC//5X, 'INDUCED COEFFS, ',9F10.9) 
F0RMATC//5X,8HEXTFLD, /) 

FORMAT C1H1) 

IF CTEMP.EQ.O.) L=-l 
IF CK.NE.O) G0T017 
SHMIT C 1 , 1 ) =~1 . 

DO 15 N=2, MAXN 

SHMIT C N , 1 ) =SHMITC N-l , 1 )*FLOAT C 2*N-3)/FL0AT C N-l ) 

SHMIT C 1 , N) =0 . 

J J=2 

DO 15 M=2, N 
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SHMIT(N,M)=SHMIT(N,M-l)XSQRTCFL0AT((N-M+l)XJJ)/FLQAT(N+M-2)) 

SHMIT(M-1,N)-SHMIT(N,M) 

15 JJ=1 

C WRITEC6 / 300 ) 

C300 FORMAT ( 1 FID SCHMIT*) 

DO 16 N=2,MAXN 
DO 16 M=1,N 

G(N,M)=GCN,M)XSHMIT(N,M> 

GT(N,M)=GT(N,M)XSHMIT(N,M) 

GTTCN,M)=GTT(N,M)XSHMIT(N,M) 

I F( NMXTTT . GT . 0 . AND . N . L E . 8 ) GTTT ( N , M ) =GTTT ( N » M ) XSHMIT ( N , M) 

IF (M.EQ.l) G0T016 
GCM-1,N)=GCM-1,N)XSHMIT(M-1,N) 

GT(M-1,N)=GT(M-1,N)XSHMITCM-1,N) 

GTT ( M- 1 , N ) =GTT ( M- 1 , N ) XSHMIT ( M-l , N ) 

I F ( NMXTTT .GT.0.AND.N.LE.8) GTTT ( M- 1 , N ) =GTTT (M-l , N) XSHMIT ( M-l , N ) 

16 CONTINUE 

IFCMODEXT .NE. 0) THEN 
DO 33 N - 2,M0DEXT 
DO 33 M « KN 

Q(N,M) = QCN,M)XSHMIT(N,M) 

IFCM , EQ. 1) GO TO 33 

QCM-l , N) = Q ( M-l , N ) XSHMIT ( M-l , N ) 

33 CONTINUE 
END IF 

C WRITE(6,310) 

C310 FORMAT ( 1 FIDCOEF*) 

17 T=TM-TZERO 

DO 18 N=1 > MAXN 
DO 18 M=1 , N 
TGX=0 . 

THX=0 . 

IF(M.EQ.l) GO TO 270 
I FCN.GT. NMXTTT) GO TO 210 
TGX=GTTTCN,M)XT 
THX=GTTT(M-1 , N)XT 
210 IFCN.GT . NMAXTT) GO TO 220 
TGX=( TGX + GTT(N,M))XT 
THX= (THX + GTT(M-l,N))xT 
220 IFCN. GT.NMAXT) GO TO 230 
TGX-CTGX + GT(N,M))XT 
THX=CTHX+GT(M-1 , N) )XT 
230 TGX=TGX+G(N,M) 

THX = THX+G(M-1 , N) 

TG(N,M)-TGX 
TG(M-1 , N) =THX 
GO TO 18 
270 CONTINUE 

I FCN.GT. NMXTTT) GO TO 240 
. TGX=GTTT(N,M)*T 
240 I FCN.GT .NMAXTT) GO TO 250 

TGX= C TGX+GTT ( N , M ) ) XT 
250 IFCN.GT.NMAXT) GO TO 260 
TGX=(TGX+GT(N,M))*T 
260 TGX= TGX+G(N,M) 

TG(N,M)=TGX 
18 CONTINUE 
TLAST=TM 

19 DLATR=DLAT/57 .2957795D0 
SINLA-SINC DLATR) 
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RL0NG=DL0NG/57 .2957795D0 
CPH=COS( RLONG) 

SPH=SIN ( RLONG) 

IF (J.EQ.O) GOT020 
C 

QI IS GEOCENTRIC RADIUS WHEN J=1 

R=Q1 

CT =SINLA 
GO TO 21 

20 SINLA2=5INLA*X2 
C 

C Ql IS GEODETIC ALTITUDE WHEN J=0 

C ALT = Q1 

C 

C0SLA2=1 . -SINLA2 

DEN2=A2-A2B2XSINLA2 

DEN=SQRT(DEN2) 

FAC=C( (Q1*DEN)+A2)/C CQ1*DEN)+B2) )**2 

CT = SINLA/SQRT ( FAC*C0SLA2+SINLA2) 

R=SQRT(Q1*(Q1+2.*DEN)+CA4-A4B4*SINLA2)/DEN2) 

21 ST=SQRTC1 .-CT*X2) 

C WRITEC6 , 330 ) DLAT , DLONG, R, TM 

330 FORMAT ( f FID f ,4F12.4) 

NMAX=MI N 0 ( NMX , MAXN ) 

NEXTF=NEXT 
DSTT = DST 
I IDST=IDST 
CALL MAGF 
Y=BP 
F=B 

IF (J) 22,23,22 

22 X=-BT 
Z=“BR 
RETURN 

C TRANSFORMS FIELD TO GEODETIC DIRECTIONS 

23 SIND=SINLA*ST-SQRTCC0SLA2)*CT 
COSD=SORT ( 1 . 0-SIND**2) 

X=-BT*COSD-BR*SIND 

Z=BT*SIND-BR*CGSD 

RETURN 

END 

C 

SUBROUTINE MAGF 

DIMENSION P(31,31),DP(31,31) , CONST (31,31),SP(31),CP(31),FN(31), 
FMC31 ) , DXDQC 31 , 31 ) , DXDSC 31 , 31 ) , DYDQC 31 , 31 ) , DYDSC31 , 31 ) , 
DZDQC 31 , 31 ) , DZDSC 31 , 31 ) 

COMMON /INDUCE/ IDST, ALFA1 , ALFA2, ALFA3, AL FA4, DST 
COMMON /COEFFS/ G(31,31) 

COMMON /FCORE/ BRC, BTC, BPC, BC, BNEXT 

COMMON /FLDCOM/ ST , CT, SPH, CPH, R, NMAX, BT, BP, BR, B, ABAR, El , E2 , E3, 
NEXT , Q( 31 , 31 ) 

DATA NCORE/14/ 

IF ( PC 1 , 1 ) . EQ . 1 . 0) GO TO 3 
1 PC1,1)=1. 

DPC 1 , 1 ) =0 . 

SPC1)=0. 

CPC1)=1 . 

DO 2 N=2, NMAX 
FN(N)=N 
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DO 2 M=1 , N 
FM(M)=M-1 

2 C0NST(N,M)=FL0AT((N-2)**2-(M-l)*X2)/FL0AT((2*N-3)*(2*N-5)) 

3 SP(2)=SPH 
CP(2)=CPH 

DO A M=3,NMAX 

SP(M)=SP(2)*CP(M-1)+CP(2)*SP(M-1) 

A CP(M)=CP(2)*CP(M-1)-SP(2)*SP(M-1) 

AOR=ABAR/R 
AR=A0R*X2 
BTC=0 . 0 
BPC=0 . 0 
BRC=0 . 0 
BC=0 . 0 
BT = 0 . 

BP=0 . 

BR=0 . 

IF(IDST.EO.O) GO TO 12 
GBAR=G( 2 , 1 ) 

G( 2, 1 )=GBAR + ALFA1XDST 
C E1BAR=E1 

C E2BAR=E2 

C E3BAR=E3 

C E1=E1 + ALFA2XDST 

C E2=E2 + ALFA3XDST 

C E3=E3 + ALFA4XDST 

El BAR = 0(2,1) 

E2BAR = 0(2,2) 

E3BAR = 0(1,2) 

0(2,1) = 0(2,1) + ALFA2KDST 

0(2,2) = Q(2,2) + ALFA3XDST 

0(1,2) = 0(1,2) + ALFA4KDST 

12 CONTINUE 

DO 8 N=2 , NMAX 
AR=AOR*AR 
DO 8 M=1 , N 
IF (N-M) 6,5,6 

5 P(N,N)=ST*P(N-1,N-1) 

DP(N,N)=ST*DP(N-1,N-1)+CTXP(N-1,N-1) 

GO TO 7 

6 P(N,M)=CT*P(N-1,M)-C0NST(N,M)*P(N-2,M) 

NOTE : CONST(2,1)=0 

DP(N,M)=CT*DP(N-1,M)-STXP(N-1,M)-C0NST(N,M)*DP(N-2,M) 

7 PAR=P(N,M)*AR 

IF (M.E0.1) GO TO 9 
TEMP=G(N,M)*CP(M)+G(M-1,N)XSP(M) 
BP=BP-(G(N,M)*SP(M)-G(M-1,N)KCP(M))*FM(M)*PAR 
GO TO 10 

9 TEMP=G(N,M)*CP(M) 

10 BT=BT+TEMP*DP(N,M)*AR 
BR=BR-TEMP*FN(N)*PAR 

IF(N.GT.NCORE) GO TO 8 

BTC=BT 

BRC=BR 

BPC=BP 

8 CONTINUE 

BP=BP/ST 

BPC=BPC/ST 
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BNEXT=SQRTCBTXBT + BP*BP + BRXBR) 

I FC NEXT . GT . 0 ) THEN 

ccc 

MONO = 2 
SIND = 0.0 
COSD =1.0 
CX = -BT 
CY = BP 
CZ = -BR 

C IF( EXTFLD . EQ . 0 ) GO TO 14 

ROA= l.O/AOR 

RB = CR0A)XXC2XCM0N0-2)+l) 

R0A2= RQAXROA 
DO 11 N= MONO, NEXT 
FNC= N-l 
RB= RBXR0A2 
DO 11 M= 1,N 
FMC- M-l 

P(N,M)= P(N,M)XRB 
DPC N, M) = DPCN,M)XRB 
TEMP= -FNCxPCN,M)XSIND - DPCN,M)XCOSD 
DXDQCN,M)= TEMPXCPCM) 

DXDSC N, M) = TEMPXSPCM) 

TEMP= FMCXPC N, M)/ST 
DYDQ(N,M)= -TEMPXSPCM) 

DYDSC N, M) = TEMPXCPCM) 

TEMP= -FNC*P(N,M)*CGSD + DPCN,M)XSIND 
DZDQCN, M)= TEMPXCPCM) 

DZDSCN,M)= TEMPXSPCM) 

IF(M .EQ. 1) THEN 

CX= CX + QCN,M)XDXDQCN,M) 

CY= CY + QCN,M)XDYDQCN,M) 

CZ= CZ + QCN,M)XDZDQCN,M) 

ELSE 

CX= CX + QCN,M)*DXDQ(N,M) + QCM-1 , N)XDXDSCN,M) 
CY= CY + QCN,M)*DYDQ(N,M) + QCM-1 , N)XDYDS(N,M) 
CZ= CZ + QCN,M)*DZDQ(N,M) + QCM-1 , N)XDZDSCN,M) 
END IF 


CONTINUE 




BRC = BRC 

+ 

( -CZ - 

BR) 

BPC = BPC 

+ 

C CY - 

BP) 

BTC = BTC 

+ 

(-CX - 

BT) 


BT = -CX 
BP = CY 
BR = -CZ 


CCC 

END IF 

B=SQRTCBTXBT+BP*BP+BRXBR) 

C xxxx BC 14 - 30) xxx 

BC=SQRT(BTCXBTC + BRCXBRC + BPCXBPC) 

BTC=BT - BTC 
BPC=BP - BPC 
BRC=BR - BRC 
BC= B - BC 

IF(IDST.EQ.O) RETURN 

IFCABSCDST) .LT.l . E-4 . AND . DST . NE . 0 . ) WRITEC6,999)ST,CT,SPH,CPH,R, 
DST , El 

999 FORMAT C10X,5F10.3, 5X,2E20 .12) 

E1=E1BAR 
E2=E2BAR 
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C E3=E3BAR 

0(2,1) = E1BAR 
0(2,2) = E2BAR 
0(1,2) = E3BAR 
G(2, 1 )=GBAR 
RETURN 

END 

SUBROUTINE EXTFLD 

COMMON/ FL DCOM/ ST , CT , S PH , CPH , R , NMAX , BT , BP , BR , B , ABAR , El , E2 , E3 
COMMON/FCORE/BRC, BTC, BPC 
T1=E2*CPH+E3*SPH 
T2=E1*ST-T1*CT 
T1=E1XCT+T1*ST 
BR=BR-T1 

BP=BP+E2XSPH-E3XCPH 

BT=BT+T2 

BRC=BRC - T1 

BPC=BPC + E2XSPH - E3XCPH 
BTC=BTC + T2 
RETURN 
END 

SUBROUTINE STEPA(x,x) 

C 

C SUBROUTINE TO FIT A TREND TO MAGNETIC FIELD RESIDUALS (OBSERVED MINUS 
C COMPUTED) WITH A B-SPLINE AND/OR FOURIER WAVEFORMS, WITH THE OPTION OF 
C FLAGGING POINTS WHOSE TREND RESIDUALS LIE OUTSIDE A GIVEN TOLERANCE 
C LEVEL AND/OR DETRENDING THE ORIGINAL DATA 

C 

CHARACTERX1 CLABEL(3) 

INTEGER H( 3) 

DIMENSION NN(3),NT(3),KA(3), ITERMX( 3) , LGRMAX( 3) , EPS(3) , KEEPDQ(8 ) 
DIMENSION K0( 3) , EKN0TS(3, 500) , FREQ ( 3, 500 ) , SIG(3, 500) , ICLASS( 3,8 ) 
REALX8 BSPLX(500),BSPLY(500),V(5,500), COEF( 500 ), D( 13000) 

REALX8 GSIG(5, 500) , EKN(500) , FRQ(500) , SIGCOM(SOO) ,RESID(500) 

REALX8 TS , TF , WTRMS , AKNOT 

COMMON /STFILE/ IST1 , IST2, IST3, ISTA 

COMMON /MDFILE/ IOR, IOW, IOF, IOD, IOB, I0F1ST, I0D1ST, I0W1ST, IOWIOF 
COMMON /SCFILE/ ISC1 , ISC2, ISC3 

COMMON /SPLINE/ H, NN,NT, KA, ITERMX, LGRMAX, EPS, KO, SIG, EKNOTS, FREQ 

COMMON /EPHEMS/ ORBINC, ERAD, IEPDAY, INCREM, INTRVL 

COMMON /FILTOP/ IMETH, ISPEC, IBTBS, SIGMLT , NFLAGK 

COMMON /LIMITS/ DXOL , DYOL, D20L , DBOL ,XWINDO, YWIND0,2WIND0, BWINDO, 

X ABVLAT , TRNLAT , ITMGAP 

C 

C COMMON REGION BSHARE COMMUNICATES BSPLYN SUBPROGRAM INFORMATION TO 
C DTREND FOR INTERPOLATION PURPOSES AND SPECT FOR SPECTRAL ANALYSES 
C 

COMMON /BSHARE/ TS,TF, EKN, FRQ, BSPLX, BSPLY, SIGCOM, V,COEF, D, WTRMS, 

* GSIG, RESID 

DATA CLABEL / *X* , »Y' , 'Z'/ 

INITIALIZE ARRAY ICLASS FOR CLASSIFICATION COUNTS IN THIS INTERVAL 

DO 1 INTR0W=1 , 3 
DO 1 INTCOL = 1 , 8 
1 ICLASSdNTROW, INTCOL ) = 0 
C 

C REWIND FILTER INPUT UNIT IOR, IF OPERATION MODES 0 OR 3 ARE USED, THEN 
C IOR = ISTA 
C 
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REMIND IOR 


C 

C SET STEP4 SCRATCH UNITS TO ISC1 AND ISC2. OUTPUT SCRATCH UNIT ISC3 
C STORES DATA QUALITY INFORMATION TO BE PLOTTED 
C 

IWS=ISC1 

IRS=ISC2 

IWP=ISC3 

C 

C REWIND THE STEP4 SCRATCH UNITS 
C 

REWIND IWS 
REWIND IRS 
REWIND IMP 
C 

C DECODE THE DATA QUALITY RETENTION CODE NFLAGK FOR THE FILTER. STORE 

C EACH DIGIT OF THE CODE IN ARRAY KEEPDQ INDICATING DATA FLAG NUMBERS 

C TO BE USED IN TREND FITTING. NFKEEP COUNTS NUMBER OF FLAGS TO BE 
C RETAINED. IKEEP6 RECORDS RETENTION STATUS FOR INOTE = 6 DATA: 

C 

C IKEEP6 = 0 — > INOTE = 6 DATA WILL BE OMITTED 

C IKEEP6 = 1 — > INOTE = 6 DATA WILL BE RETAINED 

C 

IKEEP6=0 

NFKEEP=0 

C 

C STORE RIGHT-MOST DIGIT IN NUMK AND THEN REDUCE NFLAGK 
C 

5 NUMK=M0DC NFLAGK, 10) 

IF(NUMK. EQ.6) IKEEP6=1 
NFLAGK=NFLAGK/10 
NFKEEP=NFKEEP+1 

PLACE NUMK IN ELEMENT NUMBER NFKEEP OF ARRAY KEEPDQ 


KEEPDQC NFKEEP ) =NUMK 

IF NFLAGK HAS BEEN COMPLETELY DECODED, THEN EXIT THIS PROCESS 


IF(NFLAGK.EQ.O) GO TO 10 
GO TO 5 


COUNTER DEFINITIONS: 


NREAD IS TOTAL NUMBER OF POINTS 
I IS CURRENT NUMBER OF DATA 

INTEREST 

J IS CURRENT NUMBER OF DATA 

INTERVAL OF INTEREST 
K IS CURRENT NUMBER OF DATA 

FITTING PROCESS 

L IS CURRENT NUMBER OF DATA 


READ BY THE FILTER 

POINTS FOUND WITHIN TIME INTERVAL OF 
POINTS READ THROUGH THE END OF THE 
POINTS WHICH WILL BE USED IN THE TREND 
POINTS WHICH WILL BE FILTERED 


10 NREAD=0 
1=0 
J = 0 
K=0 
L = 0 

BEGIN FILTERING INPUT DATA SET FROM UNIT IOR 
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15 J=J+ 1 

20 READCIOR,1QQ,END=50) IYR, IDAY, IETIME,GLAT,GCLAT,GLON,GMLAT,GMLON, 
*ALT,CALT,BX,BY,BZ,BB,HX,HY,HZ,HB,TX,TY,TZ,TB,DX,DY,DZ,DB,CX,CY,CZ, 
*CB,IDIR, INOTE 

100 F0RMATCI2,I4,I6,7F7 . 2, 20F8 . 1,215) 

NREAD=NREAD+1 

C 

C SETUP FOR DATA QUALITY CLASSIFICATION COUNTER ICLASS: 

C 

C ICLASSC 1 , II ) — > STATUS ON TOTAL IOR DATA SET AVAILABLE TO FILTER 
C ICLASSC 2/ II ) — > STATUS ON ACTUAL INPUT DATA SET BEING FILTERED 
C ICLASSC 3, II) — > STATUS ON ACTUAL DATA SET USED IN THE TREND FIT 
C 

C UPDATE QUALITY CLASSIFICATION COUNTS OF DATA SETS AS FOLLOWS: 

C 

C ICLASSC I , 1 ) ~> COUNTS INOTE = 0 

C ICLASSC I, 2) --> COUNTS INOTE = 1 

C ICLASSC I ,3) — > COUNTS INOTE = 2 

C ICLASSC I , 4 ) — > COUNTS INOTE = 3 

C ICLASSCIf 5) --> COUNTS INOTE = A 

C ICLASSC 1,6) --> COUNTS INOTE = 5 

C ICLASSC 1,7) --> COUNTS INOTE = 6 

C ICLASSC 1,8) — > COUNTS INOTE = 7 CIDIR = 0) 

C 

C UPDATE QUALITY CLASSIFICATION COUNTS FOR ENTIRE UNIT IOR DATA SET 
C 

ICLASSC 1 , INOTE+1 )= ICLASSC 1 , INOTE+1 )+l 
C 

C DETERMINE RELATIVE TIME OF DATA POINT CICTIME) WITH RESPECT TO 
C BEGINNING OF EPOCH DAY CIEPDAY), THEN DETERMINE ITS TIME INTERVAL CNI) 
C WITH RESPECT TO INTERVAL WIDTH CINCREM). IF CURRENT DAY (IDAY) IS 
C EARLIER THAN EPOCH DAY, THEN REJECT CURRENT POINT IMMEDIATELY 
C 

IFC IDAY-IEPDAY . LT . 0 ) GO TO 15 

ICTIME=CIDAY-IEPDAY)X86400+IETIME 

NI=INTCICTIME/INCREM)+1 

C 

C COMPARE NI WITH TIME INTERVAL OF INTEREST CINTRVL) 

C 

IFCNI-INTRVL ) 15,25,20 
25 1=1+1 
C 

C IF NI MATCHES INTRVL, THEN EVALUATE POINT WITH RESPECT TO DATA QUALITY 
C FLAGS DEFINED BELOW: 

C 

C INOTE = 0 --> NO LIMITATIONS OR CONSTRAINTS ON DATA 

C INOTE = 1 — > GROSS-OUTLIER WITH RESPECT TO OBSERVED - COMPUTED FIELD 
C INOTE = 2 --> PADDED TIME-GAP VALUE 
C INOTE = 3 --> B-SPLINE FIT-OUTLIER 
C INOTE = --> FOURIER FIT-OUTLIER 

C INOTE = 5 — > COMBINATION B-SPLINE/FOURIER FIT-OUTLIER 
C INOTE = 6 --> GEOCENTRIC LATITUDE OUTLIES TOLERANCE LEVEL ABVLAT 
C INOTE = 7 --> SATELLITE VELOCITY VECTOR DIRECTION IS INDETERMINABLE 
C 

C UPDATE QUALITY CLASSIFICATION COUNTS FOR THIS INTERVAL OF INTEREST 
C 

ICLASSC2, INOTE+1 )=ICLASSC2, INOTE+1 )+l 
C 

C WRITE INFORMATION FOR ALL POINTS IN THIS INTERVAL TO SCRATCH UNIT IWP 

A-34 


c 

WRITE(IWP) GCLAT, IDIR, INOTE, I 
C 

C IF INOTE = 6, THEN BYPASS THIS CHECK AND EVALUATE AT NEXT CHECK 
C 

IFC INOTE. EQ .6 ) GO TO 35 
C 

C CHECK DATA QUALITY FLAG INOTE AGAINST THE NFKEEP FLAGS TO BE RETAINED: 
C 

C IF INOTE MATCHES AN ELEMENT OF ARRAY KEEPDQ, THEN ACCEPT DATA POINT 
C IF INOTE DOES NOT MATCH AN ELEMENT OF KEEPDQ, THEN REJECT DATA POINT 
C 

DO 30 ICHECK=1, NFKEEP 
30 IFC INOTE. EQ.KEEPDQ(ICHECK)) GO TO 35 
GO TO 15 
35 L =L + 1 
C 

C IF CURRENT POINT PASSES PREVIOUS EVALUATION, THEN IT WILL BE FILTERED 
C CHECK IF GEOCENTRIC LATITUDE LIES WITHIN THE TOLERANCE LEVEL. FLAG 
C POINTS WITH INOTE = 6 IF THE FOLLOWING CONDITIONS EXIST: 

C 

C GCLAT > +ABVLAT — > POLAR DATA WITH GEOCENTRIC LATITUDE ABOVE +ABVLAT 
C GCLAT < -ABVLAT —> POLAR DATA WITH GEOCENTRIC LATITUDE BELOW -ABVLAT 
C 

IFCABS(GCLAT) . GT . ABVLAT) INOTE=6 
C 

C WRITE OUT ON SCRATCH UNIT IWS INFORMATION WHICH MAY BE LATER MODIFIED. 
C THIS INCLUDES POINTS THAT HAVE BEEN FLAGGED DUE TO GEOCENTRIC LATITUDE 
C CONSTRAINTS, WHICH MAY BE EXCLUDED FROM THE TREND FIT 

C 

WRITEC IWS ) TX,TY,TZ,TB,INOTE,DX,DY,DZ,DB,I 
C 

C CHECK DATA QUALITY FLAG INOTE AGAINST THE NFKEEP FLAGS TO BE RETAINED: 

C 

DO 40 ICHECK = 1 , NFKEEP 
AO IFC INOTE . EQ . KEEPDQ ( I CHECK) ) GO TO 45 
GO TO 15 
C 

C IF CURRENT POINT PASSES PREVIOUS EVALUATION, THEN IT WILL BE USED IN 
C THE TREND FIT 
C 

45 K=K+1 
C 

C UPDATE QUALITY CLASSIFICATION COUNTS FOR DATA USED IN TREND FIT 
C 

ICLASSC 3, INOTE+1 ) = ICLASSC3, INOTE+1 )+l 
C 

C STORE CURRENT ABSCISSA IN ARRAY BSPLX FOR INPUT TO BSPLYN SUBPROGRAM 

C 

BSPLXC K) =DBLEC I ) 

C 

C DETERMINE THE LOWER CTS) AND UPPER CTF) LIMIT OF THE ABSCISSA INTERVAL 
C 

IFCK.EQ.l) TS = BSPLXC K) 

IFCK.EQ.l) TF=TS 

IFC BSPLXC K) . GT . TF) TF=BSPLXCK) 

GO TO 15 
C 

C WHEN ALL DATA IS READ FROM UNIT IOR, THEN REWIND IOR FOR MODIFICATION 
C ALSO SWITCH STORAGE INPUT AND OUTPUT UNITS 
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c 

50 REWIND IOR 

CALL SWITCHC IWS, IRS) 

C 

C CALCULATE BEGINNING AND ENDING TIME IN DAYS AND SECONDS OF ARC 
C SEGMENT TO BE FILTERED, THEN PRINT HEADING 

C 

IBADD=( INTRVL-1 JXINCREM 
IEADD=IBADD+INCREM 
C 

C CALCULATE BEGINNING ( IBDY) AND ENDING (IEDY) DAYS 
C 

IBDY=IEPDAY+INT( IBADD/86A00) 

IEDY=IEPDAY+INT ( IEADD/86A00) 

C 

C CALCULATE BEGINNING (IBSC) AND ENDING (IESC) SECONDS 

C 

IBSC=MOD( IBADD, 86400 ) 

IESC=MOD(IEADD,86AOO) 

WRITEC6,101) IBDY, IBSC, IEDY, IESC 

101 FORMATC '1', 'XXiOEXiOfXiOEXXXKiOOfXXXiOEKXKXiOOnOOiXXXXXXXKXXXXKXXiOOiXXXX 

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX' 
X/1X, '**** S T E P A FILTER ARC SEGMENT FRO 
*M 5 ’»I3,’ DAYS ' , 15, ' SECS TO: ' ,13, ' DAYS ' , 15, * SECS xxxx 

*’/lX, 'XXXXXXXXXXXXXKXXXXXXXXXXXKXXXXXXXXXXXXXXXXKKXXXXXXXXXXXXXXXX 
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX’//) 

C PRINT QUALITY CLASSIFICATION STATUS OF INPUT DATA SET ON UNIT IOR 
C 

WRITEC6 ,102) 

102 FORMAT (//IX, ^CLASSIFICATION OF INPUT DATA AVAILABLE FOR FILTERING 

WRITE(6,103) (ICLASS(1,ICL),ICL=1,8),NREAD 

103 FORMAT (/6X, ’FLAG' , AX, ’COUNT' ,27X, * DESCRIPTION'/ZIX, 'INOTE = O', AX, 

*15,' --> NO LIMITATIONS OR C0NSTRAINTSV1X, ' INOTE = l',AX,I5,* -- 
*> GROSS-OUTLIER WITH RESPECT TO OBSERVED - COMPUTED FIELD’/IX, 'IN 
*OTE = 2*, AX, 15,' — > PADDED TIME-GAP VALUE’/IX, 'INOTE = 3’, AX, 15, 
*’ " > B-SPLINE FIT-0UTLIER*/1X, 'INOTE = A', AX, 15,' — > FOURIER F 
KIT-OUTLIER'/IX, 'INOTE = 5', AX, 15,' — > COMBINATION B-SPLINE/FOURI 
* ER FIT-OUTLIER'/IX, 'INOTE = 6', AX, 15,’ — > GEOCENTRIC LATITUDE LI 
*ES OUTSIDE TOLERANCE LEVEL ’/IX, • INOTE = 7', AX, 15,' --> SATELLITE 
^VELOCITY VECTOR DIRECTION IS INDETERMINABLEV/1X, 'TOTAL ====> ',1 

*5, ' RECORDS (EACH RECORD HAS A COMPONENTS: X, Y, Z, AND B)’//) 

IF NO POINTS ARE FOUND WITHIN THE INTERVAL OF INTEREST, THEN TERMINATE 

IF(I.EQ.O) WRITE(6 , 10A) INTRVL 

10A F0RMAT(//1X, 'xxxx ATTENTION: NO POINTS WERE FOUND WITHIN INTERVAL 
KNUMBER: ',13,' xxxx') 

IF(I.EQ.O) RETURN 2 

PRINT QUALITY CLASSIFICATION STATUS FOR THIS INTERVAL OF INTEREST 
WRITE(6 , 105) 

105 F0RMAT(//1X, '<FILTER INPUT DATA CLASSIFICATION>* ) 

WRITE(6,103) (ICLASS(2,ICL),ICL=1,8),I 

PRINT QUALITY CLASSIFICATION STATUS FOR DATA SET USED IN TREND FIT 
WRITE(6,106) 
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106 F0RMATC//1X, ^CLASSIFICATION OF DATA USED IN TREND FIT>') 

WRITEC 6 ,10 3) CICLASS(3,ICL),ICL=1,8),K 

C 

C PLOT VARIOUS DATA PARAMETERS 
C 

CALL DPINFOC IWP , I ) 

C 

C INDEPENDENTLY FILTER THE 3 TOPOCENTRIC FIELD COMPONENTS: IF LOOP = 1, 

C THEN X; IF LOOP = 2, THEN Y; IF LOOP = 3, THEN Z 
C 

DO 55 L00P=1,3 

WRITEC6 , 107 ) CLABEL(LOOP) 

107 FORMATC f lS «<FILTER TOPOCENTRIC B ,Al, f COMPONENT> 1 // ) 

C 

C READ FIELD COMPONENTS FROM IRS, STORE PROPER ORDINATE IN ARRAY BSPLY 
C FOR INPUT TO BSPLYN SUBPROGRAM, THEN REWIND IRS FOR NEXT COMPONENT 

C 

IV = 0 

DO 60 11=1, L 

READ(IRS) TX, TY,TZ,TB, INOTE,DX, DY,DZ,DB, III 
C 

C IF GEOCENTRIC LATITUDE OF CURRENT POINT LIES OUTSIDE TOLERANCE LEVEL 
C (INOTE =6), THEN CHECK ITS TREND FIT RETENTION STATUS 
C 

IFCCIN0TE.EQ.6) . AND . ( IKEEP6 . EQ . 0) ) GO TO 60 
IV=IV+1 

IF( LOOP . EQ . 1 ) BSPLY(IV)=DBLE(DX) 

IF( LOOP . EQ . 2) BSPLYC IV) =DBLE( DY) 

IF( LOOP . EQ . 3) BSPLYC IV) =DBLE(DZ) 

60 CONTINUE 
REWIND IRS 
C 

C TRANSFER PROPER INTERNAL KNOT INFORMATION TO ONE-DIMENSIONAL ARRAY 
C EKN FOR INPUT TO BSPLYN 
C 

KNOTF=0 

NKNOT=0 

DO 65 I 1=1 , H( LOOP) 

AKNOT = DBLEC EKNOTSC LOOP, II) ) 

C 

C CHECK IF KNOT NUMBER II FOR THIS COMPONENT LIES WITHIN TIME DOMAIN 
C (BETWEEN TS AND TF) OF THIS INTERVAL. IF IT DOES NOT, THEN OMIT THIS 
KNOT AND SET KNOTF = 1 

IFCCAKNOT.LE.TS) .OR. C AKNOT . GE.TF) ) KNOTF=l 
IFCCAKNOT.LE.TS) . OR . (AKNOT . GE . TF) ) GO TO 65 

IF KNOT LIES WITHIN TIME DOMAIN, THEN STORE IT IN THE NKNOT POSITION 
OF ARRAY EKN 

NKNOT = NKN0T+1 
EKNC NKNOT) = AKNOT 
65 CONTINUE 

IF KNOT SET HAS BEEN REDUCED (KNOTF = 1), THEN PRINT INDICATION 
IFCKNOTF. EQ.l) WRITE(6,108) NKNOT 

108 FORMATC1X, ATTENTION: KNOT SET HAS BEEN REDUCED TO *,12,' KNO 
*TS TO CONFORM WITH DATA TIME CONSTRAINTS ****'//) 

C 
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C TRANSFER PROPER A PRIORI FREQUENCY AND OBSERVATION SIGMA INFORMATION 
C TO ONE-DIMENSIONAL ARRAYS FRQ AND SIGCOM, RESPECTIVELY, FOR BSPLYN 
C 

DO 70 11=1 , NT (LOOP) 

70 FRQ( II )=DBLE(FREQ( LOOP, II ) ) 

DO 75 11=1, L 

75 SIGCOMC II ) =DBLE(SIG( LOOP, II ) ) 

C 

C FIT THE RESIDUAL DATA WITH A B-SPLINE AND/OR FOURIER WAVEFORMS USING 
C THE BSPLYN SUBPROGRAM 
C 

CALL BSPLYN(TS,TF,NN( LOOP) ,NKN0T , NT ( LOOP) , 0, 0, 0, 0, 0,2, 1,40, 

*KAC LOOP), ITERMXC LOOP), LGRMAXC LOOP), EPS( LOOP), K,K0C LOOP), EKN, FRQ, 
*BSPLX,BSPLY, SIGCOM, V, COEF, D, WTRMS, GSIG, RESID, 0 . DO) 

OPTION: PERFORM SPECTRAL ANALYSIS ON TREND FIT OF MAGNETIC COMPONENT 

IF(ISPEC.NE.O) CALL SPECTC LOOP, K, NKNOT) 

OPTION: FLAG POINTS WHOSE TREND RESIDUALS FALL OUTSIDE TOLERANCE LEVEL 

IF( ( IMETH . NE. 0 ) . AND. C IMETH . NE. 3) ) CALL OUTLIE( RESID, K, L , LOOP, IRS, 
xlWS) 

OPTION: DETREND INPUT MAGNETIC FIELD COMPONENTS 

55 IF( (IMETH. NE. 2) .AND . ( IMETH . NE. 3) ) CALL DTRENDC LOOP, K, L , IRS, INS, 
XNKNOT) 

WRITE OUT FILTERED DATA SET TO UNIT IOW 

CALL MODIFY( I , J , L, IRS, IWS) 

RETURN 1 
END 

SUBROUTINE SPECT(LOOP,K, NKNOT) 

C 

C SUBROUTINE TO PERFORM SPECTRAL ANALYSIS ON TREND FITS OF THE MAGNETIC 
C FIELD COMPONENTS IN THE FREQUENCY DOMAIN USING A MIXED-RADIX FAST 
C FOURIER TRANSFORM. ANALYSIS MAY BE DONE DIRECTLY OR WITH ZERO-MEAN 
C ADJUSTMENT 
C 

L0GICALX1 I XFMT ( 7 ) , I YFMT ( 7 ) 

INTEGER H(3) 

DIMENSION NN(3),NT(3),KA(3), ITERMXC 3) , LGRMAXC 3) , EPS(3) , KO(3) 
DIMENSION EKN0TS(3,500) , FREQ(3,500) , SIG(3,500),AMP(500),PHI(500) 
DIMENSION POWER(500),PERIOD(500) 

REAL *8 BSPLXf 500), BSPLY( 500), VC5, 500), C0EF(500),D( 13000) 

REAL *8 GSIGC5, 500) , EKNC500) , FRQC500) , SIGCOMC 500 ) ,RESID( 500) 

REALX8 Q( 5, 500 ),TS,TF, WTRMS, AREAL C 500), AIMAGC 500) 

COMMON /FILTOP/ IMETH, ISPEC, IBTBS, SIGMLT, NFLAGK 

COMMON /SPLINE/ H , NN, NT, KA, ITERMX, LGRMAX, EPS, KO, SIG, EKNOTS, FREQ 

COMMON /BSHARE/ TS, TF, EKN, FRQ, BSPLX, BSPLY, SIGCOM, V, COEF, D, WTRMS, 

X GSIG, RESID 

C 

C SET DEGREES-TO-RADIANS CONVERSION 
C 

DTR=3 . 141 5926 5300/ 180 . DO 
C 

C DETERMINE TOTAL NUMBER OF INPUT DATA VALUES CNTOTL), ASSUMING A TIME 
C INCREMENT OF ITMGAP SECONDS, OVER THE TIME SEGMENT FROM TS TO TF FIT 
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BY THE TREND 

ITS=NINT(TS) 

ITF=NINT(TF) 

NTOTL =ITF-ITS+1 
C 

C SET FLAG FOR ODD (I EVEN = 0) OR EVEN Cl EVEN = 1) NUMBER OF DATA POINTS 
C 

IEVEN=0 

IFCMODC NTOTL , 2) . EQ . 0 ) IEVEN=1 
C 

C DETERMINE HALF-INTERVAL ( IHALF) OF SYMMETRIC DATA INTERVAL (NTOTL) 

C 

IHALF=NT0TL/2+l 

C 

C GENERATE AN ARRAY (AREAL) CONTAINING REAL COMPONENTS OF THE DATA AT 
C EQUALLY SPACED TIME INTERVALS OF ITMGAP SECONDS OVER THE TIME SEGMENT 
C FROM ITS TO ITF . IV IS CURRENT ELEMENT OF AREAL TO BE ASSIGNED AND IB 
C IS CURRENT ELEMENT OF BSPLX AND COUNT OF NEXT TREND FIT VALUE TO BE 
C ASSIGNED TO AREAL 
C 

IV=0 
IB=1 
SUM=0 . 0 

DO 10 I=ITS,ITF 
IV=IV+1 
C 

C SET IMAGINARY COMPONENT OF INPUT DATA ( AIMAG) TO ZERO 
C 

AIMAG( IV ) =0 . DO 
C 

C DETERMINE WHETHER TREND FIT VALUE EXISTS AT CURRENT RELATIVE TIME I 
C 

IFCI.EQ.NINTCBSPLX(IB))) GO TO 20 
C 

C IF CURRENT RELATIVE TIME VALUE I DOES NOT MATCH TIME VALUE OF NEXT 
C TREND FIT POINT, THEN CALL SUBPROGRAM BSPLYN TO INTERPOLATE A TREND 
C FIT VALUE AT TIME I, THEN ASSIGN THIS VALUE QC1,1) TO CURRENT ELEMENT 
C OF AREAL 
C 

XINTRP=DBLE( I ) 

CALL BSPLYNCTS, TF, NNC LOOP), NKNOT,NT( LOOP), 0,0, 0,1, 0,2, 1,40, 

*KA( LOOP) , ITERMXC LOOP) , LGRMAXC LOOP) , EPS( LOOP) ,K,KO( LOOP) , EKN, FRQ, 
*BSPLX, BSPLY, SIGCOM, Q, COEF, D, WTRMS.GSIG, RESID, XINTRP) 
AREAL(IV)=Q(1,1) 

GO TO 10 
C 

C IF CURRENT RELATIVE TIME VALUE I MATCHES TIME VALUE OF NEXT TREND FIT 
C POINT (STORED IN ELEMENT IB OF BSPLX), THEN ASSIGN TREND FIT VALUE OF 
C THAT POINT VC1,IB) TO CURRENT ELEMENT OF AREAL 
C 

20 AREAL (IV)=V(1,IB) 

IB=IB+1 

C 

C SUM THE REAL COMPONENTS OF THE DATA 
C 

10 SUM=SUM+REAL (AREAL(IV)) 

C 

C IF ISPEC = 1, DETERMINE DATA MEAN AND SUBTRACT FROM REAL COMPONENTS 
C IF ISPEC = 2, DO NOT DETERMINE OR SUBTRACT DATA MEAN 
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c 


IFCISPEC.E9.2) GO TO 30 
AMEAN=SUM/REAL ( NTOTL ) 

DO AO IM=1, NTOTL 
AO AREAL CIM)=AREAL( IM)-AMEAN 
C 

C COMPUTE COMPLEX FOURIER TRANSFORM OF AN NTOTL NUMBER OF REAL, EQUALLY 
C SPACED DATA COMPONENTS IN PLACE USING A MIXED-RADIX FAST FOURIER 
C TRANSFORM. SUBPROGRAM FFT RETURNS REAL AND IMAGINARY COMPONENTS OF THE 
C RESULTING FOURIER COEFFICIENTS IN AREAL AND AIMAG, RESPECTIVELY 

30 CALL FFTCAREAL, AIMAG, NTOTL, NTOTL, NTOTL, 1) 

PRINT SPECTRAL ANALYSIS HEADINGS 

WRITEC6 , 100 ) 

100 FORMAT(//lX, *<SPECTRAL ANALYSIS OF TREND FIT>') 

IF(ISPEC.EQ.l) WRITEC 6,101) 

101 FORMAT(/lX, ’#* THIS IS A ZERO-MEAN ANALYSIS XX') 

IFCISPEC.EQ.2) WRITEC6 , 102) 

102 FORMATL/1X, *xx THIS IS A DIRECT ANALYSIS XX') 

WRITE(6, 103) 

103 FORMATt/lX, 'NUM' ,8X, ' PERIOD' , 16X, 'AMPLITUDE' ,20X, 'PHASE*, 20X, 'POWE 

XR’/) 

CALCULATE VARIOUS SPECTRA ONLY IN POSITIVE FREQUENCY DOMAIN DUE TO 
SYMMETRY CONSIDERATIONS 

DO 50 IK=2, IHALF 
IKM1=IK-1 

CALCULATE POWER SPECTRUM 

POWERC IKM1 )=REAL (2 . D0X( AREAL ( IK)xx2+AIMAG( IK)XX2) ) 

CALCULATE PHASE SPECTRUM 

PHICIKM1 )=REAL ( DATAN2C AIMAGC IK) , AREAL (IK) )/DTR) 

CALCULATE AMPLITUDE SPECTRUM 

AMP( IKM1 ) =REAL ( DSQRT( AREAL ( IIOXX2+AIMAGC IK) XX2) ) 

IF EVEN NUMBER OF DATA POINTS WERE ANALYZED, THEN HIGHEST FREQUENCY 
AMPLITUDE IS EQUALLY DISTRIBUTED OVER ITS CORRESPONDING POSITIVE AND 
NEGATIVE FREQUENCIES 

IF( ( IK. EQ .IHALF) .AND. (I EVEN . EQ . 1) ) AMP( IKM1 )=AMP( IKM1 )/2 . 0 
CALCULATE PERIODS CORRESPONDING TO FOURIER FREQUENCIES 
PERIOD( IKM1 ) =REAL ( NTOTL )/REAL ( IK-1 ) 

PRINT FREQUENCY NUMBER, CORRESPONDING PERIOD, AND VARIOUS SPECTRA 

50 HRITE(6, 104 ) IKM1 , PERIODC IKM1 ) , AMP( IKM1 ) , PHI ( IKM1 ) , POWERt IKM1 ) 

104 FORMAT (IX, 13, 4X, FI 0.5, 3F25 . 5 ) 

PLOT VARIOUS SPECTRA 
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LT0TL=IHALF-1 


INITIALIZE PRINTER PLOTTING 
CALL PL OTST (00001,1) 

DETERMINE MINIMUM AND MAXIMUM VALUES FOR PERIOD 
CALL MAXMINCPERIOD, LTOTL , XMIN,XMAX) 
DETERMINE PLOTTING FORMAT FOR PERIOD 


CALL FORMAT(XMIN,XMAX, IXFMT) 

IF NPLT = 1, PLOT AMPLITUDE SPECTRUM ON LOG VERSUS LOG GRID 
IF NPLT = 2, PLOT PHASE SPECTRUM ON LINEAR VERSUS LOG GRID 
IF NPLT = 3, PLOT POWER SPECTRUM ON LOG VERSUS LOG GRID 

DO 60 NPLT=1 , 3 

DETERMINE MINIMUM AND MAXIMUM VALUES FOR AMPLITUDE, PHASE, AND POWER 
DETERMINE FORMAT OF ORDINATE FOR PHASE PLOT 

IFCNPLT. EQ.l) CALL MAXMINCAMP, LTOTL , YMIN, YMAX) 

IFCNPLT . EQ . 2) CALL GRDNUM( PHI , LTOTL , YMIN, YMAX, KINT, IYFMT) 
IFCNPLT.EQ.3) CALL MAXMINt POWER, LTOTL, YMIN, YMAX) 

DETERMINE FORMAT OF ORDINATE FOR AMPLITUDE AND POWER PLOTS 


IF(NPLT.NE.2) CALL FORMATCYMIN, YMAX, IYFMT) 


DEFINE CARTESIAN OBJECT SPACE FOR PLOTS 


C 

CALL SETGRDC 11. 0,12. 0,123. 0,65. 0,1) 


C 

C IF PLOTTING: 

C 

C AMPLITUDE — > OVERLAY CARTESIAN LOG-LOG GRID WITH TICK MARKS 

C PHASE — > OVERLAY CARTESIAN SEMI-LOG GRID WITH TICK MARKS 

C POWER --> OVERLAY CARTESIAN LOG-LOG GRID WITH TICK MARKS 

C 

IF( NPLT . EQ . 2) CALL OGRIDCXMIN, XMAX, 9 , IXFMT, 2, YMIN, YMAX, KINT, IYFMT , 

* 2 , 1 ) 

IFCNPLT . NE . 2) CALL OGRIDCXMIN, XMAX, 9 , IXFMT, 2, YMIN, YMAX, 9, IYFMT , 


*2,3) 

C 

C PLOT AMPLITUDE, PHASE, 
C 

IF(NPLT.EQ.l) CALL 
IFCNPLT. EQ. 2) CALL 
IFCNPLT.EQ.3) CALL 


AND POWER SPECTRA 

PLOTCPERIOD, AMP, LTOTL, • ') 
PLOTCPERIOD, PHI, LTOTL, • ') 
PLOTCPERIOD, POWER, LTOTL, • ') 


C 

C PRINT HEADING 
C 

IFCNPLT. EQ.l) CALL HORLINC 'AMPLITUDE SPECTRUM (LOG VS. LOG)', 32, 
*66.0,67.0,0,0) 

IFCNPLT. EQ. 2) CALL HORLINC 'PHASE SPECTRUM (LINEAR VS. LOG) ',31, 
*66.0,67.0,0,0) 

IFCNPLT.EQ.3) CALL HORL INC • POWER SPECTRUM CLOG VS. LOG)', 28, 
*66.0,67.0,0,0) 
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c 

C LABEL INDEPENDENT AXIS 
C 

CALL HORLINC 'PERIOD' ,6.66.0,8.0,0,0) 

60 IFCNPLT . LE . 2) CALL FRMADV 

TERMINATE PLOTTING SEQUENCE 

CALL ENDPLT 
RETURN 
END 

SUBROUTINE FFT( A, B, NTOT, N. NSPAN, ISN) 

C MULTIVARIATE COMPLEX FOURIER TRANSFORM, COMPUTED IN PLACE 
C USING MIXED-RADIX FAST FOURIER TRANSFORM ALGORITHM. 

C BY R. C. SINGLETON, STANFORD RESEARCH INSTITUTE, OCT. 1968 
C ARRAYS A AND B ORIGINALLY HOLD THE REAL AND IMAGINARY 
C COMPONENTS OF THE DATA, AND RETURN THE REAL AND 

C IMAGINARY COMPONENTS OF THE RESULTING FOURIER COEFFICIENTS. 

C MULTIVARIATE DATA IS INDEXED ACCORDING TO THE FORTRAN 
C ARRAY ELEMENT SUCCESSOR FUNCTION, WITHOUT LIMIT 

C ON THE NUMBER OF IMPLIED MULTIPLE SUBSCRIPTS. 

C THE SUBROUTINE IS CALLED ONCE FOR EACH VARIATE. 

C THE CALLS FOR A MULTIVARIATE TRANSFORM MAY BE IN ANY ORDER. 

C NTOT IS THE TOTAL NUMBER OF COMPLEX DATA VALUES. 

C N IS THE DIMENSION OF THE CURRENT VARIABLE. 

C NSPAN/N IS THE SPACING OF CONSECUTIVE DATA VALUES 
C WHILE INDEXING THE CURRENT VARIABLE. 

C THE SIGN OF ISN DETERMINES THE SIGN OF THE COMPLEX 
C EXPONENTIAL, AND THE MAGNITUDE OF ISN IS NORMALLY ONE. 

C A TRI-VARIATE TRANSFORM WITH A(N1,N2,N3), B(N1,N2,N3) 

C IS COMPUTED BY 

C CALL FFT(A,B,N1KN2XN3,N1,N1,1) 

C CALL FFTCA,B,N1XN2*N3,N2,N1*N2,1) 

C CALL FFT(A,B,N1*N2*N3,N3,N1XN2*N3,1) 

C FOR A SINGLE-VARIATE TRANSFORM, 

C NTOT = N = NSPAN = (NUMBER OF COMPLEX DATA VALUES), E.G. 

C CALL FFT( A, B, N, N, N, 1 ) 

C THE DATA MAY ALTERNATIVELY BE STORED IN A SINGLE COMPLEX 
C ARRAY A, THEN THE MAGNITUDE OF ISN CHANGED TO TWO TO 

C GIVE THE CORRECT INDEXING INCREMENT AND AC2) USED TO 

C PASS THE INITIAL ADDRESS FOR THE SEQUENCE OF IMAGINARY 

C VALUES, E.G. 

C CALL FFT(A,A(2), NTOT, N, NSPAN, 2) 

C ARRAYS AT(MAXF) , CK(MAXF) , BTCMAXF), SK(MAXF) , AND NP(MAXP) 

C ARE USED FOR TEMPORARY STORAGE. IF THE AVAILABLE STORAGE 
C IS INSUFFICIENT, THE PROGRAM IS TERMINATED BY A STOP. 

C xxx TO CONVERT PROGRAM TO DOUBLE PRECISION, REMOVE C FROM 

C FOLLOWING STATEMENTS 

DOUBLE PRECISION A, B , AA, BB, AJ , BJ , AK, BK, AT, BT, AJM, BJM, AKM, BKM 
DOUBLE PRECISION AJP , B JP, AKP, BKP,C1, C2, C3, SI , S2, S3, CD, SD,CK, SK 
DOUBLE PRECISION S72, C72, S120 , RAD, RADF, ZERO, HALF, ONE, TWO, FIVE 
C MAXF MUST BE .GE. THE MAXIMUM PRIME FACTOR OF N. 

C MAXP MUST BE .GT. THE NUMBER OF PRIME FACTORS OF N. 

C IN ADDITION, IF THE SQUARE-FREE PORTION K CF N HAS TWO OR 

C MORE PRIME FACTORS, THEN MAXP MUST BE .GE. K-l . 

DIMENSION AC1),B(1) 

C ARRAY STORAGE IN NFAC FOR A MAXIMUM OF 20 FACTORS OF N. 

C IF N HAS MORE THAN ONE SQUARE-FREE FACTOR, THE PRODUCT OF THE 
C SQUARE-FREE FACTORS MUST BE .LE. 502 
DIMENSION NFAC ( 20 ) , NPC 501 ) 
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C ARRAY STORAGE FOR MAXIMUM PRIME FACTOR OF 501 
DIMENSION ATC501),CKC501),BTC501),SKC501) 

EQUIVALENCE (I, II) 

SINC AA) =DSINC AA ) 

COSCAA)=DCOSCAA) 

FLOAT C I ) =DFLOAT Cl) 

C THE FOLLOWING TWO CONSTANTS SHOULD AGREE WITH THE ARRAY DIMENSIONS. 
MAXF=501 
MAXP=501 

IFCN . LT . 2) RETURN 
INC=ISN 

RAD=6 . 283185307179586 A76 9 25286 766 559 0057 6 

S72=RAD/5.0 

C72=C0SC S72) 

S72=SINC S72) 

C S120=SQRTC3)/2 

S120=0 . 866 025A0378AA386A676372317075293618 
IFC ISN . GE . 0 )GO TO 10 
S72=-S72 
S120=-S120 
RAD=-RAD 
INC=-INC 
10 NT=INC*NTOT 
KS=INC*NSPAN 
KSPAN=KS 
NN=NT-INC 
JC=KS/N 

RADF=RAD*FLOATC JC)*0.5 
1 = 0 
JF = 0 

C DETERMINE THE FACTORS OF N 
M=0 
K=N 

GO TO 20 
15 M=M+1 

NFACCM)=4 

K=K/16 

20 IF(K-CK/16)*16 . EQ . 0) GO TO 15 
J = 3 
J J = 9 

GO TO 30 
25 M=M+1 

NFAC(M) = J 
K=K/JJ 

30 IFCMOD(K,JJ) .EQ. 0) GO TO 25 
J=J + 2 
JJ=J**2 

IFC JJ .LE. K) GO TO 30 
IFCK .GT. A) GO TO AO 
KT=M 

NFACC M+l ) =K 
IFCK . NE. 1 ) M=M+1 
GO TO 80 

AO IFCK-CK/A)*A .NE. 0) GO TO 50 
M=M+1 
NFACCM) =2 
K = K/A 
50 KT=M 
J=2 

60 IFCMODCK,J) .NE. 0) GO TO 70 
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M=M+1 
NFAC(M)= J 
K=K/J 

70 J=( ( J+l )/2)x2+l 

IFCJ .LE. K) GO TO 60 
80 IFCKT .EQ. 0) GO TO 100 
J=KT 

90 M=M+1 

NFACC M) =NFAC( J ) 

J=J-1 

IFCJ .NE. 0) GO TO 90 
C COMPUTE FOURIER TRANSFORM 
100 SD=RADF/Ft OAT ( KSPAN) 

CD=2.0XSINCSD)XX2 

SD=SIN(SD+SD) 

KK=1 
1 = 1+1 

IFCNFACCI) .NE. 2) GO TO 400 

C TRANSFORM FOR FACTOR OF 2 (INCLUDING ROTATION FACTOR) 
KSPAN =KSPAN/2 
Kl=KSPAN+2 
210 K2=KK+KSPAN 
AK=ACK2) 

BK=B(K2) 

ACK2)=A( KK)-AK 
B(K2)=B(KK)-BK 
A(KK)=A(KK)+AK 
B(KK)=B(KK)+BK 
KK=K2+KSPAN 

IFCKK .LE. NN) GO TO 210 
KK=KK-NN 

IFCKK .LE. JC) GO TO 210 
IFCKK .GT. KSPAN) GO TO 800 
220 Cl =1 . 0-CD 
SI =SD 

230 K2=KK+KSPAN 

AK=A(KK)-A(K2) 

BK=BCKK)-B(K2) 

ACKK) =ACKK)+ACK2) 

BCKK)=BCKK)+BCK2) 

ACK2)=C1XAK-S1*BK 

B(K2)=Sl*AK+ClxBK 

KK=K2+KSPAN 

IFCKK .LT. NT) GO TO 230 

K2=KK-NT 

C1=-C1 

KK=K1-K2 

IFCKK .GT. K2) GO TO 230 
AK=C1-(CD*C1+SD*S1) 

S1=CSD*C1-CD*S1)+S1 

C THE FOLLOWING THREE STATEMENTS COMPENSATE FOR TRUNCATION 
C ERROR. IF ROUNDED ARITHMETIC IS USED, SUBSTITUE 

C C1=AK 

Cl=0.5/CAK*X2+Sl**2)+0.5 

S1=C1XS1 

C1=C1XAK 

KK=KK+JC 

IFCKK .LT. K2) GO TO 230 

K1=K1+INC+INC 

KK=CKl-KSPAN)/2+JC 
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IFCKK .LE. JC+JC) GO TO 220 
GO TO 100 

C TRANSFORM FOR FACTOR OF 3 (OPTIONAL CODE) 
320 K1=KK+KSPAN 
K2=K1+KSPAN 
AK=A(KK) 

BK=B(KK) 

AJ=A(K1 )+A(K2) 

BJ=B(K1 )+B( K2) 

A(KK)=AK+AJ 

B(KK)=BK+BJ 

AK=-0 . 5XAJ+AK 

BK=-0.5*BJ+BK 

AJ=(A(K1)-ACK2))XS120 

BJ=(B(K1)-B(K2))XS120 

ACK1 )=AK-BJ 

BCK1)=BK+AJ 

A(K2)=AK+BJ 

BCK2)=BK-AJ 

KK=K2+KSPAN 

IFCKK . LT . NN) GO TO 320 
KK=KK-NN 

IFCKK .LE. KSPAN) GO TO 320 
GO TO 700 

C TRANSFORM FOR FACTOR OF A 

400 IFCNFACCI) .NE. 4) GO TO 600 
KSPNN=KSPAN 
KSPAN = KSPAN/ 4 
410 Cl=1.0 
S1 = 0. 

420 K1=KK+KSPAN 
K2=K1+KSPAN 
K3=K2+KSPAN 
AKP=A(KK)+A(K2) 

AKM=A(KK)-A(K2) 

AJP=ACK1)+A(K3) 

AJM=ACK1)-ACK3) 

AC KK)=AKP+AJP 
AJP=AKP-AJP 
BKP=B( KK)+B( K2) 

BKM=BCKK)-B(K2) 

BJP=BCK1)+B(K3) 

BJM=BC K1 )“BC K3) 

B(KK)=BKP+BJP 

BJP=BKP-BJP 

IFCISN .LT. 0) GO TO 450 

AKP=AKM“BJM 

AKM=AKM+BJM 

BKP=BKM+AJM 

BKM=BKM-AJM 

IFCS1 .EQ. 0.0) GO TO 460 
430 A(K1)=AKP*C1-BKP*S1 
B(K1)=AKP*S1+BKP*C1 
ACK2)=AJP*C2-BJP*S2 
BCK2)=AJP*S2+BJP*C2 
ACK3)=AKM*C3-BKM*S3 
B(K3)-AKM*S3+BKM*C3 
KK=K3+KSPAN 

IFCKK .LE. NT) GO TO 420 
440 C2=C1-(CDXC1+SD*S1) 
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S1=CSD*C1-CD*S1)+S1 

C THE FOLLOWING THREE STATEMENTS COMPENSATE FOR TRUNCATION 
C ERROR. IF ROUNDED ARITHMETIC IS USED, SUBSTITUTE 

C C1=C2 

C1=0 . 5/CC2**2+Sl*X2)+0 .5 

S1=C1XS1 

C1=C1*C2 

C2=C1*X2-S1*X2 

S2=2. 0*C1*S1 

C3=C2XC1-S2XS1 

S3=C2*S1+S2XC1 

KK=KK-NT+JC 

IFCKK .LE.KSPAN) GO TO 420 
KK=KK-KSPAN+INC 
IFCKK .LE. JC) GO TO 410 
IFCKSPAN . EQ . JC) GO TO 800 
GO TO 100 
450 AKP=AKM+BJM 
AKM=AKM-BJM 
BKP=BKM-AJM 
BKM=BKM+AJM 

IFCSl .NE. 0.0) GO TO 430 
460 ACK1 )=AKP 
BC KI ) =BKP 
ACK2)=AJP 
BC K2)=BJP 
AC K3)=AKM 
BCK3)=BKM 
KK=K3+KSPAN 

IFCKK .LE. NT) GO TO 420 
GO TO 440 

C TRANSFORM FOR FACTOR OF 5 C OPTIONAL CODE) 

510 C2=C72XX2-S72*X2 
S2=2.0XC72*S72 
520 K1=KK+KSPAN 
K2=K1+KSPAN 
K3=K2+KSPAN 
K4=K3+KSPAN 
AKP=ACK1)+ACK4) 

AKM=ACK1)-ACK4) 

BKP=BCK1)+BCK4) 

BKM=BCK1)-BCK4) 

AJP=ACK2)+ACK3) 

AJM=AC K2)-AC K3) 

BJP=BCK2)+BCK3) 

BJM=BCK2)-BCK3) 

AA=ACKK) 

BB=BCKK) 

AC KK) =AA+AKP+AJP 

BC KK) = BB+BKP+BJP 

AK=AKP*C72+AJP*C2+AA 

BK=BKP*C72+BJP*C2+BB 

AJ=AKM*S72+AJM*S2 

BJ=BKM*S72+BJM*S2 

ACK1)=AK-BJ 

ACK4)=AK+BJ 

BCK1)-BK+AJ 

BCK4)=BK-AJ 

AK=AKP*C2+AJP*C72+AA 

BK=BKPXC2+BJP*C72+BB 
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AJ=AKM*S2-AJM*S72 

BJ=BKM*S2-BJM*S72 

A(K2)=AK-BJ 

ACK3)=AK+BJ 

BCK2)=BK+AJ 

B( K3)=BK-AJ 

KK=K4+KSPAN 

IFCKK .LT. NN) GO TO 520 
KK=KK-NN 

IFCKK .LE. KSPAN) GO TO 520 
GO TO 700 

C TRANSFORM FOR ODD FACTORS 
600 K=NFACC I ) 

KSPNN=KSPAN 

KSPAN=KSPAN/K 

IF( K . EQ . 3) GO TO 320 

IFCK . EQ . 5) GO TO 510 

IFCK .EQ. JF) GO TO 640 

JF=K 

SI = RAD/ FLOAT C K) 

C1=C0S(S1) 

SI =SIN( SI ) 

IFCJF .GT. MAXF) GO TO 998 
CKC JF) = 1 . 0 
SKC JF) =0 . 0 
J = 1 

630 CKC J)=CKCK)XC1+SK(K)*S1 
SKC J )=CK( K)XS1“SKC K)XC1 
K = K-1 

CKCK)=CKC J) 

SKC K) =-SKC J ) 

J = J + 1 

IFCJ .LT. K) GO TO 630 
640 K1=KK 

K2=KK+KSPNN 

AA=ACKK) 

BB=BCKK) 

AK=AA 
BK=BB 
J = 1 

K1=K1+KSPAN 
650 K2=K2-KSPAN 
J = J + l 

ATC J)=ACK1)+ACK2) 

AK=ATC J)+AK 
BTC J)=B(K1)+BCK2) 

BK=BT C J )+BK 
J = J + 1 

ATC J)=A(K1)-ACK2) 
BTCJ)=BCK1)-BCK2) 
K1=K1+KSPAN 

IFCK1 .LT. K2) GO TO 650 
ACKK) =AK 
BCKK) =BK 
K1=KK 

K2=KK+KSPNN 
J = 1 

660 K1=K1+KSPAN 
K2=K2-KSPAN 
JJ = J 



AK=AA 
BK = BB 
AJ = 0 . 0 
BJ = 0 . 0 
K = 1 

670 K=K+1 

AK=ATCK)*CK(JJ)+AK 

BK=BTCK)*CK(JJ)+BK 

K=K+1 

AJ=AT(K)*SK(JJ)+AJ 

BJ=BTCK)XSKCJJ)+BJ 

JJ=JJ+J 

IFCJJ .GT. JF) J J= J J-JF 

IF( K .IT. JF) GO TO 670 

K=JF-J 

ACK1)=AK-BJ 

B(K1)=BK+AJ 

A(K2)=AK+BJ 

B( K2) =BK“AJ 

J = J + 1 

IFCJ .LT. K) GO TO 660 
KK=KK+KSPNN 

IF( KK .LE. NN) GO TO 640 
KK=KK-NN 

IFCKK .LE. KSPAN) GO TO 640 

C MULTIPLY BY ROTATION FACTOR (EXCEPT FOR FACTORS OF 2 AND 4) 
700 IFCI .EQ. M) GO TO 800 
KK= JC+1 
710 C2=l . O-CD 

51 =SD 
720 Cl =C2 

52 = S1 

KK=KK+KSPAN 
730 AK=A( KK) 

ACKK)=C2*AK-S2*B(KK) 

B(KK)=S2*AK+C2XB(KK) 

KK=KK+K$PNN 

IFCKK .LE. NT) GO TO 730 

AK r Sl *S2 

S2=S1*C2+C1*$2 

C2=C1*C2-AK 

KK=KK“NT+KSPAN 

IFCKK .LE. KSPNN) GO TO 730 

C2=C1-(CD*C1+SD*S1) 

S1=S1+(SD*C1-CD*S1) 

C THE FOLLOWING THREE STATEMENTS COMPENSATE FOR TRUNCATION 
C ERROR. IF ROUNDED ARITHMETIC USED, THEY MAY 

C BE DELETED. 

C1=0 .5/(C2x*2+S1*X2)+0 .5 

S1=C1*S1 

C2=C1*C2 

KK=KK-KSPNN+JC 

IFCKK .LE. KSPAN) GO TO 720 

KK=KK*-KSPAN+JC+INC 

IFCKK .LE. JC+JC) GO TO 710 

GO TO 100 

C PERMUTE THE RESULTS TO NORMAL ORDER DONE IN TWO STAGES 

C PERMUATION FOR SQUARE FACTORS OF N 
800 NPC 1 ) =KS 

IFCKT .EQ. 0) GO TO 890 
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K=KT+KT+1 

IFCM .LT. K) K=K-1 
J = 1 

NP(K+1 )=JC 

810 NP( J+l ) =NP( J )/NFAC( J ) 

NP( K) =NP( K+l )*NFAC( J ) 

J=J+1 

K=K-1 

IF( J .LT. K) GO TO 810 
K3=NP( K+l ) 

KSPAN=NP(2) 

KK= JC+1 

K2=KSPAN+1 

J=1 

IF(N .NE. NTOT) GO TO 850 

C PERMUTATION FOR SINGLE-VARIATE TRANSFORM (OPTIONAL CODE) 
820 AK=A(KK) 

A(KK)=A(K2) 

A(K2)=AK 

BK=B(KK) 

B(KK)=B(K2) 

B(K2)=BK 

KK=KK+INC 

K2=KSPAN+K2 

IFCK2 .LT. KS) GO TO 820 
830 K2=K2-NP(J) 

J = J + 1 

K2=NP( J+l )+K2 

IFCK2 .GT. NP( J ) ) GO TO 830 
J = 1 

840 IF(KK .LT. K2) GO TO 820 
KK=KK+INC 
K2=KSPAN+K2 

IFCK2 .LT. KS) GO TO 840 
IFCKK .LT. KS) GO TO 830 
JC=K3 
GO TO 890 

C PERMUATION FOR MULTIVARIATE TRANSFORM 
850 K=KK+JC 
860 AK=A( KK) 

ACKK)=A(K2) 

A(K2)=AK 

BK=B(KK) 

BCKK)=BCK2) 

B(K2)=BK 

KK=KK+INC 

K2=K2+INC 

IF(KK .LT. K) GO TO 860 

KK=KK+KS-JC 

K2=K2+KS-JC 

IF(KK .LT. NT) GO TO 850 

K2=K2-NT+KSPAN 

KK=KK-NT+JC 

IF(K2 .LT. KS) GO TO 850 
870 K2=K2-NP(J) 

- J=J+1 

K2=NP( J+l)+K2 

IF(K2 .GT. NP( J ) ) GO TO 870 
J = 1 

880 IF(KK .LT. K2) GO TO 850 
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KK=KK+JC 

K2=KSPAN+K2 

IFCK2 .LT. KS) GO TO 580 
IFCKK .LT. KS) GO TO 870 
JC=K3 

890 IFC2XKT+1 .GE. M) RETURN 
KSPNN=NPC KT+1 ) 

C PERMUTATION FOR SQUARE-FREE FACTORS OF N 
J=M-KT 
NFACC J+l)=l 

900 NFACC J)=NFACC J)*NFACCJ+1) 

J = J-I 

IFCJ .NE. KT) GO TO 900 

KT=KT+1 

NN=NFACCKT)-1 

IFCNN .GT. MAXP) GO TO 998 
JJ = 0 
J = 0 

GO TO 906 
902 JJ=JJ-K2 
K2=KK 
K = K+1 

KK=NFACCK) 

909 J J=KK+J J 

IFCJJ .GE. K2) GO TO 902 
NPC J ) = J J 
906 K2=NFACCKT) 

K=KT+1 

KK=NFAC(K) 

J = J+ 1 

IFCJ .LE. NN)GO TO 909 

C DETERMINE THE PERMUATION CYCLES OF LENGTH GREATER THAN 1 
J = 0 

GO TO 91 A 

910 K=KK 
KK=NPCK) 

NPCK)=-KK 


IFCKK 

.NE 

. J) 

GO 

TO 

910 

K3=KK 






J = J + 1 






KK=NPC 

J) 





IFCKK 

.LT 

. 0) 

GO 

TO 

919 

IFCKK 

.NE 

. J) 

GO 

TO 

910 

NPC J)= 

-J 





IFCJ . 

NE. 

NN) 

GO 

TO 

919 


MAXF=INC*MAXF 

C REORDER A AND B, FOLLOWING THE PERMUTATION CYCLES 
GO TO 950 
929 J=J- 1 

IFCNPCJ) .LT. 0) GO TO 929 
JJ=JC 

926 KSPAN=J J 

IFCJJ .GT. MAXF) KSPAN=MAXF 
J J = J J-KSPAN 
K=NPC J) 

KK= JC*K+I 1+ J J 

K1=KK+KS£AN 

K2=0 

928 K2=K2+1 

ATC K2) =AC K1 ) 
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BT(K2)=B(K1) 

K1=K1-INC 

IFCK1 .NE. KK) 60 TO 928 
932 K1=KK+KSPAN 

K2=K1-JC*CK+NPCK)) 

K=-NPCK) 

936 ACK1)=ACK2) 

BCK1)=BCK2) 

K1=K1-INC 

K2=K2-INC 

IFCK1 .NE. KK) 60 TO 936 
KK=K2 

IFCK .NE. J) 60 TO 932 

K1=KK+KSPAN 

K2=0 

940 K2=K2+1 

ACK1 ) =AT ( K2 ) 

BCK1 ) =BT ( K2) 

K1=K1-INC 

IFCK1 .NE. KK) 60 TO 940 
IF( J J .NE. 0) 60 TO 926 
IF( J .NE. 1) 60 TO 924 
950 J=K3+1 

NT=NT-KSPNN 

II=NT-INC+1 

IF(NT . 6E. 0) 60 TO 924 
RETURN 

C ERROR FINISH, INSUFFICIENT ARRAY ST0RA6E 

998 ISN=0 
PRINT 999 

999 FORMAT ( 44H0ARRAY BOUNDS EXCEEDED WITHIN SUBROUTINE FFT) 
RETURN 

END 

SUBROUTINE REALTRC A, B, N, ISN ) 

C IF ISN=1 , THIS SUBROUTINE COMPLETES THE FOURIER TRANSFORM 
C OF 2*N REAL DATA VALUES, WHERE THE 0RI6INAL DATA VALUES ARE 

C STORED ALTERNATELY IN ARRAYS A AND B, AND ARE FIRST 

C TRANSFORMED BY A COMPLEX FOURIER TRANSFORM OF DIMENSION N. 

C THE COSINE COEFFICIENTS ARE IN AC 1 ) , A( 2) , . . . A(N+1) AND 
C THE SINE COEFFICIENTS ARE IN BC 1 ) , B( 2) , . . . BCN+1 ) . 

C A TYPICAL CALLIN6 SEQUENCE IS 

C CALL FFTC A, B, N, N, N, 1 ) 

C CALL REALTRCA,B,N, 1) 

C THE RESULTS SHOULD BE MULTIPLIED BY 0.5/N TO 6IVE THE 
C USUAL SCALIN6 OF COEFFICIENTS. 

C IF ISN=-1, THE INVERSE TRANSFORMATION IS DONE, THE FIRST STEP 
C IN EVALUATIN6 A REAL FOURIER SERIES. 

C A TYPICAL CALLIN6 SEQUENCE IS 

C CALL REALTRCA, B, N, -1 ) 

C CALL FFT(A,B,N,N,N,-1) 

C THE RESULTS SHOULD BE MULTIPLIED BY 0.5 TO 6IVE THE USUAL 
C SCALIN6, AND THE TIME DOMAIN RESULTS ALTERNATE IN ARRAYS A 
C AND B, I.E. A(1),B(1),A(2),B(2), . . .A(N),B(N). 

C THE DATA MAY ALTERNATIVELY BE STORED IN A SIN6LE COMPLEX 
C ARRAY A, THEN THE MA6NITUDE OF ISN CHAN6ED TO TWO TO 
C 6IVE THE CORRECT INDEXIN6 INCREMENT AND AC2) USED TO 

C PASS THE INITIAL ADDRESS FOR THE SEQUENCE OF IMA6INARY 

C VALUES, E.6. 

C CALL FFT ( A , A ( 2 ) , N , N , N , 2 ) 

C CALL REALTRCA, A(2),N, 2) 
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c IN THIS CASE, THE COSINE AND SINE COEFFICIENTS ALTERNATE IN A. 
C BY R.C. SINGLETON, STANFORD RESEARCH INSTITUTE, OCT. 1968 
C xxx TO CONVERT PROGRAM TO DOUBLE PRECISION, REMOVE C FROM 
C FOLLOWING STATEMENTS 

REAL IM 

DOUBLE PRECISION A , B, AA, BB, AB, BA, BI , AR, SD, CD, SN, CN, FN, PI 
DOUBLE PRECISION ZERO, ONE, TWO, HALF 
DIMENSION A( 1) , B( 1 ) 

SIN(AA)=DSIN(AA) 

FLOAT ( I ) =DFL OAT ( I ) 

INC=IABS( ISN) 

NK=NXINC+2 

NH=NK/2 

SD-3 . 1 415926 5358 97 9323846 26A338327950288/FLOAT(2*N) 

CD=2.0XSIN(SD)XX2 

5D=SIN( SD+SD) 

SN=0 . 0 

IF( ISN . LT . 0 )GO TO 30 
CN=1 . 0 

A(NK-1)=AC1) 

B( NK-1 ) =B( 1 ) 

10 DO 20 J=1 , NH, INC 
K=NK-J 

AA=A(J)+ACK) 

AB=AC J)-A(K) 

BA=B( J )+B(K) 

BB=B(J)-B(K) 

RE=CNXBA+SNXAB 

IM=SNXBA-CNXAB 

B( K) = IM-BB 

B( J ) = IM+BB 

A(K)=AA-RE 

AC J)=AA+RE 

AA=CN-CCDXCN+SDXSN) 

SN=CSDXCN-CDXSN)+SN 

C THE FOLLOWING THREE STATEMENTS COMPENSATE FOR TRUNCATION 
C ERROR. IF ROUNDED ARITHMETIC IS USED, SUBSTITUTE 
C 20 CN=AA 

CN=0 .5/CAAXX2+SNXx2)+0.5 
SN=CNXSN 
20 CN=CNXAA 
RETURN 
30 CN=-1.0 
SD=-SD 
GO TO 10 
END 

SUBROUTINE FASTFTCN, H, ISN) 

C COMPUTES FAST FOURIER TRANSFORM OF 2XXN POINTS 

C N = NUMBER OF POINTS 

C H = COMPLEX ARRAY OF DATA TO BE TRANSFORMED 

C ISN = 1 FOR DIRECT TRANSFORM, 0 FOR INVERSE TRANSFORM 

DIMENSION M( 20) 

COMPLEX H(N),WK,A,B 
VA=6 . 28 31 8 53070/ FLOAT ( N) 

IFC ISN . GT . 0 ) VA=-VA 
LOG=l 
K = N 

1 K=K/2 
M( LOG) =K 

IFCK.EQ.DGO TO 2 
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L0G=LDG+1 
GO TO 1 

2 K = 0 

DO 5 L = 1 , LOG 
NB=2**CL-1) 

LB=N/NB 
LBH=LB/2 
K = 0 

DO 5 IB=1,NB 
V=VA*FLOATCK) 

WK=CMPLXCCOSCV),SINCV)) 

IS=LB*C IB-1 ) 

DO 3 1=1, LBH 
J=IS+I 
JH= J+LBH 
A=H(J) 

B=HC JH)*WK 
HCJH)=A-B 

3 HCJ)=A+B 

DO 4 1=2, LOG 

IFC K . LT . M( I ) )GO TO 5 

4 K=K-MCI) 

5 K=K+MCI) 

K=0 

DO 8 J = 1 , N 

IFC K . LT . J )GO TO 6 

A=H( J) 

H( J ) =H( K+l ) 

HCK+1)=A 

6 DO 7 1=1, LOG 

IFC K . LT . M( I ) )GO TO 8 

7 K=K-MCI) 

8 K=K+MC I ) 

IFC ISN .GT . 0) RETURN 
A=CMPLXC 1. /FLOAT C N ), 0. ) 

DO 9 1=1, N 

9 HCI)=H(I)*A 
RETURN 

END 

SUBROUTINE OUTLIEC RESID, K, L , LOOP, IRS, IWS) 

C 

C SUBROUTINE TO COMPUTE STATISTICS ON B-SPLINE AND/OR FOURIER TREND FIT 
C RESIDUAL VECTOR, WHERE K IS THE VECTOR LENGTH. THEN FLAG POINTS WHOSE 
C TREND RESIDUALS LIE OUTSIDE A SPECIFIED MULTIPLE CSIGMLT) OF THE TREND 
C FIT RESIDUAL SIGMA CRSIGMA) 

C 

INTEGER HC 3) 

DIMENSION NNC3),NTC3),KAC3), ITERMXC 3) , LGRMAXC3) , EPSC3) , K0C3) 
DIMENSION EKN0TSC3, 500) , FREQC3,500) ,SIGC3,500) 

REAL*8 RESIDC 500) 

COMMON /FILTOP/ IMETH, ISPEC, IBTBS, SIGMLT , NFLAGK 

COMMON /SPLINE/ H , NN, NT, KA , ITERMX, LGRMAX, EPS, KO, SIG, EKNOTS, FREQ 
C 

C CALCULATE TREND RESIDUAL MEAN 
C 

RMEAN=0 . 0 
DO 10 IB=1 , K 
10 RMEAN=RMEAN+RESIDC IB) 

RMEAN=RMEAN/REALCK) 
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CALCULATE TREND RESIDUAL SIGMA 

RSIGMA=0 . 0 
DO 20 IB=1,K 

20 RSIGMA=RSIGMA+(RESID(IB)-RMEAN)**2 
RSIGMA=SQRT C RSIGMA/REAL ( K-l ) ) 

C 

C CALCULATE THE TOLERANCE LEVEL FOR TREND RESIDUALS AND PRINT HEADING 

C 

TOLER=RSIGMAXSIGMLT 
WRITEC6, 100) TOLER 

100 FORMATC//1X, '<RESIDUALS FOUND OUTSIDE SIGMA TOLERANCE LEVEL OF: ', 

*F15.5, • *NUM',6X, 'TIME' ,1 AX, 'RESIDUAL * ,6X, ' FLAG'/) 

C 

C BEGIN PROCESSING RESIDUALS AND READING DATA DUALITY INFORMATION ON 
C SCRATCH INPUT UNIT IRS 
C 

ID=0 
KALT = 0 

DO 30 IB=1,L 

READ(IRS) TX,TY,TZ,TB,INOTE,DX,DY,DZ,DB,I 

C 

C IF GEOCENTRIC LATITUDE OF CURRENT POINT LIES OUTSIDE TOLERANCE LEVEL 
C (INOTE = 6), THEN DO NOT INVOLVE POINT IN RESIDUAL OUTLIER CHECK 

C 

IFCINOTE. ED . 6 ) GO TO 30 
C 

C ID IS ELEMENT NUMBER OF CURRENT RESIDUAL TO BE CHECKED 
C 

ID=ID+1 

C 

C IF MAGNITUDE OF TREND RESIDUAL LIES OUTSIDE THE TOLERANCE LEVEL, RESET 
C THE DATA DUALITY FLAG INOTE USING THE FOLLOWING CRITERIA: 

C 

C INOTE = 3 --> IF POINT IS A B-SPLINE FIT-OUTLIER 

C INOTE = A --> IF POINT IS A FOURIER FIT-OUTLIER 

C INOTE = 5 — > IF POINT IS A COMBINATION B-SPLINE/FOURIER FIT-OUTLIER 

C 

IFCABSCRESIDCID)) .LE. TOLER) GO TO 30 
C 

C DATA POINT HAS BEEN FOUND OUTSIDE THE TOLERANCE LEVEL. PRINT THE 
C RESIDUAL, ITS SEQUENTIAL OUTLIER NUMBER CKALT) , ITS TIME Cl), AND 
C THE ASSIGNED DATA QUALITY FLAG (INOTE) 

C 

KALT=KALT+1 
RTIME=REAL Cl) 

IFC NNC LOOP ) . GT . 0 ) IN0TE=3 
I FC NT (LOOP) .GT.O) INOTE=A 

IFC CNNC LOOP) .GT.O) .AND. (NTC LOOP) .GT.O)) IN0TE=5 
WRITEC 6 ,101) KALT, RTIME,RESID( ID), INOTE 

101 FORMAT (1X,I3,2X,F8.3,7X,F15.5,6X,IA) 

C 

C WRITE DATA DUALITY INFORMATION BACK OUT TO SCRATCH UNIT IWS 
C 

30 WRITEC IWS) TX, TY, TZ, TB, INOTE, DX, DY, DZ, DB, I 
C 

C SWITCH SCRATCH INPUT AND OUTPUT UNITS FOR NEXT DATA MODIFICATION 
C 

CALL SWITCH ( IWS, IRS) 

RETURN 
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END 

SUBROUTINE DTRENDC L OOP , K , L , I RS , IWS , NKNOT ) 

C 

C SUBROUTINE TO DETREND THE OBSERVED GEOCENTRIC MAGNETIC DATA, THAT IS, 

C SUBTRACT THE TREND FIT OF THE RESIDUALS (DX,DY,DZ) 

C 

INTEGER H( 3) 

DIMENSION NN(3),NT(3),KA(3), ITERMXC3) , LGRMAXC 3) , EPSC3) , KOC 3) 
DIMENSION EKN0TSC3, 500) , FREQC 3, 500) , SIGC 3,500) 

REAL*8 BSPLX(500),BSPLY(500),V(5,500), COEFC500) , DC 13000) 

REALX8 GSIGC5, 500) , EKNC500) , FRQC500) ,SIGCOM(500) , RESIDC500) 

REAL *8 Q(5,500),TS,TF, WTRMS 

COMMON /SPLINE/ H, NN, NT, KA, ITERMX, LGRMAX, EPS,K0,SIG, EKNOTS, FREQ 
COMMON /BSHARE/ TS , TF, EKN, FRQ, BSPLX, BSPLY, SIGCOM, V,COEF, D, WTRMS, 

* GSIG, RESID 

C 

C BEGIN MODIFYING OBSERVED MAGNETIC FIELD, WHICH IS READ IN ON SCRATCH 
C INPUT UNIT IRS. NUMOUT COUNTS NUMBER OF GEOCENTRIC LATITUDE OUTLIERS 

C 

NUMOUT =0 
KB=0 

DO 10 IB=1 , L 

READCIRS) TX, TY , TZ, TB, I NOTE, DX, DY, DZ, DB , I 
C 

C DETERMINE IF POINT NUMBER IB WAS USED IN TREND FITTING 

C 

IF( INOTE . EQ . 6 ) GO TO 20 
C 

C IF POINT NUMBER IB WAS USED IN TREND FITTING, THEN KB RECORDS THE 
C POSITION OF ITS COMPUTED TREND VALUE IN ARRAY V 

C 

KB=KB+1 

TREND=REAL ( VC 1 , KB) ) 

GO TO 30 
C 

C IF POINT NUMBER IB WAS NOT USED IN TREND FITTING, THEN ITS GEOCENTRIC 
C LATITUDE LIES OUTSIDE THE TOLERANCE LEVEL CINOTE = 6), SO CALL BSPLYN 
C SUBPROGRAM USING INTERPOLATION MODE: 

C 

C INTERPOLATION ABSCISSA SUPPLIED — > TIME I 
C INTERPOLATION ORDINATE RETURNED — > 0(1,1) 

C 

C PRINT TREND FIT INTERPOLATION HEADING 
C 

20 NUMOUT =NUMOUT+l 

I Ft NUMOUT . EQ . 1 ) WRITE(6,100) 

100 FORMATC//1X, ’<GEOCENTRIC LATITUDE OUTLIER INTERPOLATION INFORMATIO 
*N>’//1X, 'NUM* ,6X, ’TIME' ,7X, ’COMPONENT VALUE’/) 

XINTRP=DBLE(I) 

CALL BSPLYNCTS, TF, NNC LOOP) , NKNOT , NT C LOOP) , 0, 0, 0, 1 ,0,2,1,40, 

XKAC LOOP) , ITERMXC LOOP) , LGRMAXC LOOP) , EPSC LOOP) , K, KOC LOOP) , EKN, FRQ, 
XBSPLX, BSPLY, SIGCOM, Q,COEF,D, WTRMS, GSIG, RESID, XINTRP) 

TREND=REAL ( Q( 1 , 1 ) ) 

C 

C PRINT TREND FIT INTERPOLATION ABSCISSA, ORDINATE, AND OUTLIER NUMBER 

C 

WRITEC 6,101) NUMOUT, XINTRP, TREND 

101 FORMAT (1X,I3,2X,F8.3,2X,F20.10) 

DETREND ONE COMPONENT OF THE OBSERVED AND RESIDUAL MAGNETIC FIELD 
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C DEPENDING UPON THE VALUE OF LOOP 
C 

30 IF( LOOP . EQ . 1 ) TX=TX-TREND 
IF( LOOP . EQ . 1 ) DX=DX-TREND 
IF( LOOP . EQ . 2) TY=TY-TREND 
IF( LOOP . EQ . 2) DY=DY-TREND 
IF( LOOP . EQ . 3) T2=TZ“TREND 
IF( LOOP . EQ . 3) DZ=DZ-TREND 
C 

c IF ALL 3 VECTOR COMPONENTS HAVE BEEN DETRENDED, THEN CALCULATE 
C DETRENDED SCALAR VALUES 
C 

IFC LOOP . EQ . 3) TB=SQRT ( TX* TX+TY*TY+TZ*TZ ) 

IF( LOOP . EQ . 3) DB=SQRT ( DX*DX+DYXDY+DZ*DZ) 

C 

C WRITE MODIFIED MAGNETIC FIELD BACK OUT TO SCRATCH UNIT IMS 

C 

10 WRITE(IWS) TX,TY,TZ,TB,INOTE,DX,DY,DZ,DB, I 
C 

C SWITCH SCRATCH INPUT AND OUTPUT UNITS FOR NEXT DATA MODIFICATION 
C 

CALL SWITCH C IWS, IRS) 

RETURN 

END 

SUBROUTINE MODIFYC I , J , L , IRS, IWS) 

C 

C SUBROUTINE TO WRITE MODIFIED DATA SET TO UNIT IOW WHICH HAS BEEN 
C OUTPUT BY THE FILTER FOR THIS TIME INTERVAL OF INTEREST 
C 

DIMENSION ICLASSC 2, 8 ) 

COMMON /MDFILE/ I OR, IOW, I OF, I OD, I OB, IOF1ST , IOD1ST, IOW1ST , IOWIOF 
C 

C INITIALIZE ARRAY ICLASS FOR CLASSIFICATION COUNTS IN THIS INTERVAL 
C 

DO 1 INTROW=l , 2 
DO 1 INTCOL = 1 , 8 
1 ICLASSC INTROW, INTCOL ) =0 
C 

C BEGIN FILTER OUTPUT PROCEDURES FOR THIS INTERVAL, REWIND UNIT IOW 
C 

REWIND IOW 
C 

C SETUP FOR DATA QUALITY CLASSIFICATION COUNTER ICLASS: 

C 

C ICLASSC 1,11) — > STATUS ON TOTAL DATA SET EXISTING ON UNIT IOW 
C ICLASSC2, II) — > STATUS ON FILTERED OUTPUT DATA SET FOR THIS INTERVAL 
C 

C COUNTER DEFINITIONS: 

C 

C NRIOW COUNTS TOTAL RECORDS EXISTING ON UNIT IOW 
C 

NRIOW=0 

C 

C CHECK IF CURRENTLY GENERATED FILTER OUTPUT WILL BE FIRST DATA 
C CIOW1ST = 1) OR APPENDED DATA CIOW1ST = 0) ON UNIT IOW. 

C IF APPENDED, THEN POSITION FILE MARKER AFTER LAST EXISTING RECORD 
C 

IFC IOW1ST . EQ . 1 ) GO TO 15 

5 READC IOW, 200 , END=1 0 ) IYR, IDAY, IETIME, GLAT , GCLAT,GLON, GMLAT, GMLON, 
XALT , CALT , BX, BY, BZ, BB, HX, HY, HZ, HB, TX,TY,TZ, TB, DX, DY, DZ, DB, CX, CY, CZ, 
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*CB,IDIR,INOTE 

200 FORMAT (12, 14 , 16 , 7F7 . 2, 20F8 .1,215) 

NRIOW=NRIOW+1 

C 

C UPDATE QUALITY CLASSIFICATION COUNTS OF DATA SET CURRENTLY ON UNIT IOW 
C 

ICLASSC1, IN0TE+1)=ICLASSC1,IN0TE+1)+1 
GO TO 5 

10 BACKSPACE IOW 
C 

C COUNTER DEFINITIONS: 

C 

C II IS CURRENT NUMBER OF POINTS READ ON UNIT IOR 

C JJ IS CURRENT NUMBER OF POINTS FOUND IN TIME INTERVAL OF INTEREST 

C LL IS CURRENT NUMBER OF MODIFIED POINTS 

C 

15 11=0 
JJ = 0 
L L = 0 
C 

C BEGIN READING INPUT DATA SET ON UNIT IOR 
C 

20 READ(I0R,200,END=35) IYR, IDAY, IETIME,GLAT,GCLAT,GLON,GMLAT,GMLON, 
*ALT,CALT,BX,BY,BZ,BB,HX,HY,HZ,HB,TX,TY,TZ,TB,DX,DY,DZ,DB,CX,CY,CZ, 
XCB,IDIR,INOTE 
11 = 11+1 
C 

C CHECK IF CURRENT POINT IS WITHIN TIME INTERVAL OF INTEREST: 

C 

C INTERVAL RANGES FROM RECORD NUMBER CJ-I) TO CJ-1) ON UNIT IOR 
C 

IF( II . LT . J-I ) GO TO 20 
IFCII .GT. J-l) GO TO 35 
C 

C CURRENT POINT LIES WITHIN THE TIME INTERVAL OF INTEREST. CHECK IF ALL 
C MODIFIED DATA POINTS (L) HAVE BEEN WRITTEN OUT , IF SO, THEN WRITE OUT 
C DUPLICATE RECORD 
C 

IF(LL.GE.L) GO TO 30 
JJ=JJ+1 
C 

C IF ALL MODIFIED POINTS HAVE NOT BEEN WRITTEN OUT, THEN READ NEXT SET 
C OF MODIFICATION INFORMATION ON SCRATCH UNIT IRS 
C 

READ(IRS) PX, PY, PZ, PB, MNOTE, QX, QY, QZ, QB, III 
IFCJJ.LT. Ill) GO TO 25 
C 

C IF CURRENT POINT IN INTERVAL (JJ) MATCHES CURRENT POINT TO BE MODIFIED 
C (III), THEN WRITE OUT THE MODIFIED POINT AND RECORD MODIFICATION TOTAL 
C 

LL=LL+1 

WRITEC IOW, 200) IYR, IDAY, IETIME,GLAT,GCLAT,GLON,GMLAT,GMLON, ALT, 
XCALT , BX, BY, BZ, BB, HX, HY, HZ, HB , PX, PY, PZ, PB, QX, QY, QZ, QB, CX, CY, CZ, CB, 
XIDIR, MNOTE 
C 

C UPDATE QUALITY CLASSIFICATION COUNTS OF DATA SET FOR FILTER OUTPUT 
C 


C 


I CL ASS ( 2, MNOTE+1 ) =ICLASS( 2, MNOTE+1 )+l 
GO TO 20 
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C IF CURRENT POINT IN INTERVAL DOES NOT MATCH CURRENT POINT TO BE 
C MODIFIED, THEN WRITE OUT DUPLICATE RECORD AND BACKSPACE UNIT IRS TO 
C RETAIN CURRENT MODIFICATION INFORMATION 
C 

25 BACKSPACE IRS 
C 

C UPDATE QUALITY CLASSIFICATION COUNTS OF DATA SET FOR FILTER OUTPUT 

C 

30 ICL ASS (2, INOTE+1 )= ICL ASS( 2, INOTE+1 ) + l 
C 

C WRITE OUT DUPLICATE DATA RECORDS TO UNIT IOW 

C 

WRITE(ION,200) IYR, IDAY, IETIME, GLAT , GCL AT, GLON, GMLAT , GMLON, ALT , 
*CALT,BX,BY,BZ,BB,HX,HY,HZ,HB,TX,TY,TZ,TB,DX,DY,DZ,DB,CX,CY,CZ,CB, 
XIDIR, INOTE 
GO TO 20 
C 

C ADJUST CLASSIFICATION COUNTS FOR TOTAL UNIT IOW DATA SET DUE TO NEWLY 
C APPENDED FILTER DATA 

C 

35 NRIOW=NRIOW+I 
DO 40 IADD=1,8 

40 ICLASSC 1 , IADD) =ICLASS( 1 , I ADD)+ICLASS(2, IADD) 

C 

C PRINT QUALITY CLASSIFICATION STATUS OF DATA SET OUTPUT FROM THE FILTER 

C 

WRITE(6,201) 

201 FORMATC//1X, '<FILTER OUTPUT DATA CLASSIFICATIONS ) 

WRITEC6 , 202) ( ICLASSC 2, ICL ) , ICL=1 ,8 ) , I 

202 FORMAT(/6X, 'FLAG', 4X, 'COUNT', 27X, 'DESCRIPTIONV/IX, ’INOTE = 0»,4X, 

*15, ' --> NO LIMITATIONS OR CONSTRAINTS '/IX, * INOTE = l',4X,I5,' — 
*> GROSS-OUTLIER WITH RESPECT TO OBSERVED - COMPUTED FIELD'/IX, ' IN 
*OTE = 2' ,4X, 15, ' --> PADDED TIME-GAP VALUE'/IX, * INOTE = 3',4X,I5, 
*' --> B-SPLINE FIT-OUTLIER'/IX, 'INOTE = 4',4X,I5,' --> FOURIER F 
*IT-0UTLIER'/1X, 'INOTE = 5',4X,I5,’ --> COMBINATION B-SPLINE/FOURI 
*ER FIT-OUTLIER’/IX, 'INOTE = 6',4X,I5,' --> GEOCENTRIC LATITUDE LI 
*ES OUTSIDE TOLERANCE LEVEL '/IX, 'INOTE = 7*,4X,I5,' --> SATELLITE 
VELOCITY VECTOR DIRECTION IS INDETERMINABL E'//1X, 'TOTAL ====> ',1 

*5,* RECORDS (EACH RECORD HAS 4 COMPONENTS : X, Y, Z, AND B)'//) 

PRINT QUALITY CLASSIFICATION STATUS OF TOTAL DATA SET ON UNIT IOW 

WRITE(6 , 203) IOW 

203 FORMAT (✓✓IX, '<T0TAL FILTERED OUTPUT DATA CLASSIFICATION EXISTING 0 
*N UNIT ',12, •>') 

WRITE(6 , 202) ( ICLASS( 1, ICL), ICL -1,8), NRIOW 
RETURN 
END 

SUBROUTINE DPINFO( IWP, NTOTL ) 

C 

C SUBROUTINE TO PLOT VARIOUS DATA PARAMETERS: TIME/LATITUDE POSITION, 

C VELOCITY VECTOR DIRECTION, AND TIME-GAP/OUTLIER INFORMATION 
C 

CHARACTERX1 SYMBOL (8) 

LOGICALX1 INUM 
DIMENSION X(500),Y(500) 

COMMON /EPHEMS/ ORBINC, ERAD, IEPDAY, INCREM, INTRVL 

COMMON ✓LIMITS/ DXOL , DYOL , DZOL , DBOL , XWINDO, YWINDO, ZWINDO , BWINDO, 

* ABVL AT , TRNLAT , ITMGAP 

C 
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DEFINE SYMBOLS USED IN PLOTTING 

DATA SYMBOL , 'O', 'G' , 'B', 'F', 'C'/ 

INITIALIZE PRINTER PLOTTING, DEFINE CARTESIAN OBJECT SPACE, AND 
OVERLAY CARTESIAN LINEAR GRID WITH TICK MARKS 

XMAX=REAL ( NTOTL ) 

CALL PLOTST (00001,1) 

CALL SETGRDC 11 .0,12.0,123.0,62.0,1) 

CALL OGRID(1.0,XMAX, 8, ’13)', 1,-90. 0,90.0, IS, '13)', 2,0) 

PLOT THE LATITUDE TOLERANCE WINDOW DEFINED BY +ABVLAT AND -ABVLAT 
USING THE SYMBOL — > = 

DO 10 L = 1 , 2 
DO 20 K=l, NTOTL 
IFCL.EQ.l) X(K)=REAL (K) 

IF(L.EQ.l) YCK)=ABVLAT 
20 IF( L . EQ . 2) Y(K)=-YCK) 

10 CALL PLOTCX, Y, NTOTL, ’ = ') 

PLOT 8 DATA POINT PARAMETERS, ONE AT A TIME 

DO 30 IDQUAL = 1 , 8 

REWIND SCRATCH UNIT IWP, WHICH CONTAINS PARAMETER INFORMATION 

REWIND IWP 
IK=0 


BEGIN READING PARAMETER INFORMATION FOR ALL NTOTL POINTS ON UNIT IWP 

DO AO K=l, NTOTL 
READ(IWP) GCLAT , IDIR, INOTE, I 
C 

C CHECKING SEQUENCE FLAGS 

C 


c 

IF 

IDQUAL 

= 

i. 

CHECK 

FOR 

ASCENDING POINTS 

IDIR 

= 

1 

c 

IF 

IDQUAL 

= 

2, 

CHECK 

FOR 

DESCENDING POINTS 

IDIR 

= 

-1 

c 

IF 

IDQUAL 

= 

3, 

CHECK 

FOR 

TURN-AROUND POINTS 

IDIR 

= 

0 

c 

IF 

IDQUAL 

= 

A, 

CHECK 

FOR 

GROSS-OUTLIERS 

INOTE 

r 

1 

c 

IF 

IDQUAL 

= 

5, 

CHECK 

FOR 

PADDED TIME-GAP POINTS 

INOTE 

= 

2 

c 

IF 

IDQUAL 

= 

6, 

CHECK 

FOR 

B-SPLINE FIT-OUTLIERS 

INOTE 

= 

3 

c 

IF 

IDQUAL 

= 

7, 

CHECK 

FOR 

FOURIER FIT-OUTLIERS 

INOTE 

= 

<4 

c 

IF 

IDQUAL 

= 

8, 

CHECK 

FOR 

B-SPLINE/ FOURIER FIT-OUTLIERS 

INOTE 

r 

5 


C 

I F( ( IDQUAL . EQ . 1 ) . AND . ( IDIR . GT . 0 ) ) GO TO 50 
IF((IDQUAL.EQ.2) . AND .( IDIR . LT . 0 ) ) GO TO 50 
IF((IDQUAL.EQ.3) . AND .( IDIR . EQ . 0 ) ) GO TO 50 
I F( ( IDQUAL . EQ . A) .AND . (INOTE . EQ . 1 ) ) GO TO 50 
IF( (IDQUAL . EQ . 5) . AND. (INOTE . EQ .2) ) GO TO 50 
IF( (IDQUAL . EQ .6 ) . AND. ( INOTE . EQ . 3) ) GO TO 50 
IF( (IDQUAL . EQ . 7 ) . AND . ( INOTE . EQ . A) ) GO TO 50 
IF( (IDQUAL . EQ . 8 ) . AND. (INOTE . EQ . 5) ) GO TO 50 
GO TO AO 
C 

C IF PARTICULAR DATA QUALITY IS CURRENTLY FOUND, THEN STORE POINT TIME 
C IN ARRAY X, POINT LATITUDE IN ARRAY Y, AND RECORD TOTAL POINTS HAVING 
C THIS QUALITY 
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c 

50 IK=IK+1 

XC IK) =REAL ( I ) 

Y(IK)=GCLAT 
40 CONTINUE 
C 

C PLOT POINTS HAVING CURRENT DATA QUALITY WITH FOLLOWING SYMBOLS: 

C ASCENDING — > + , DESCENDING --> -, TURNING — > X, GROSS OUTLIER — > 0, 
C TIME-GAP --> G, B-SPLINE FIT OUTLIER — > B, FOURIER FIT OUTLIER — > F, 
C COMBINATION B-SPLINE/FOURIER FIT OUTLIER --> C 
C 

30 IFCIK.NE.O) CALL PLOTCX, Y, IK, SYMBOL ( IDQUAL ) ) 

PRINT HEADING AND LEGEND 

CALL HORLINC 'DATA QUALITY INFORMATION FOR INTERVAL: *,39,66.0, 
*67.0,0,0) 

CALL EDIT ( INTRVL , * 12) * , INUM, NNUM, IBL ) 

CALL HORLINC INUM, 2, 66. 0,67 .0,40,0) 

CALL HORLINC 'ASCENDING — > + DESCENDING — > - TURNING --> X GRO 
XSS OUTLIER --> 0 TIME-GAP --> G B-SPLINE FIT OUTLIER — > B',113, 
*66.0,65.0,0,0) 

CALL HORLINC 'FOURIER FIT OUTLIER — > F COMBINATION B-SPLINE/FOURI 
*ER FIT OUTLIER — > C LATITUDE TOLERANCE RANGE — > = ’,113, 

*66 .0,64.0,0,0) 


LABEL PLOT AXES 

CALL HORLINC 'TIME' , 4 , 66 . 0 , 8 . 0 , 0 , 0) 

CALL VERLINC 'LATITUDE', 8, 5. 0,37. 0,0,0) 

TERMINATE PLOTTING SEQUENCE 

CALL ENDPLT 
RETURN 
END 

SUBROUTINE SWITCHC IWS, IRS) 

C 

C SWITCH SCRATCH INPUT AND OUTPUT UNITS BETWEEN UNITS ISC1 AND ISC2. IWS 
C AND IRS ARE CURRENT OUTPUT AND INPUT UNITS, RESPECTIVELY 
C 

AUX=IWS 

IWS=IRS 

IRS=AUX 

C 

C REWIND THE NEW IRS UNIT FOR NEXT READING AND THE NEW IWS UNIT FOR NEXT 
C WRITING 
C 

REWIND IRS 
REWIND IWS 
RETURN 
END 

SUBROUTINE STEP5 
C 

C SUBROUTINE TO WRITE OUT FINAL MODIFIED SATELLITE MAGNETIC FIELD DATA 
C 

C THREE VERSIONS OF FINAL DATA TAPES ARE AVAILABLE INDICATED BY IBTBS : 

C 

C Cl) IF IBTBS = 0: WRITE OUT TO UNIT IOF: 

C A) EPHEMERIS INFORMATION 
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c 

B) 

TOPOCENTRIC OBSERVED FIELD 


c 

C) 

TOPOCENTRIC RESIDUAL FIELD 


c 

D) 

TOPOCENTRIC COMPUTED FIELD 


c 

E) 

DATA QUALITY INFORMATION 

‘ 

c 

c 

C 2) IF IBTBS = Is WRITE OUT TO UNIT IOF: 


c 

A) 

EPHEMERIS INFORMATION 

< 

c 

B) 

FIT/MAGSAT OBSERVED FIELD 

SAME 

c 

C) 

FIT/MAGSAT RESIDUAL FIELD 

AS 

c 

D) 

TOPOCENTRIC OBSERVED FIELD 

UNIT 

c 

E) 

TOPOCENTRIC RESIDUAL FIELD 

ION 

c 

F) 

TOPOCENTRIC COMPUTED FIELD 


c 

G) 

DATA QUALITY INFORMATION 

< 

c 

H) 

GEOMAGNETIC LATITUDE OUTLIER 

INFORMATION 

c 

c 

WRITE OUT TO BINARY UNIT IOB IN 

FIT FORMAT: 

c 

A) 

EPHEMERIS INFORMATION 


c 

B) 

DATA QUALITY INFORMATION 


c 

C) 

FIT/MAGSAT OBSERVED FIELD 


c 

D) 

GEOMAGNETIC LATITUDE OUTLIER 

INFORMATION 


c 

C (3) IF IBTBS = 2: SAME AS OPTION C2), BUT AN ADDITIONAL DATA TAPE, 

C ANALOGOUS TO TAPE WRITTEN TO UNIT IOF, WILL BE 

C WRITTEN OUT TO UNIT IOD IN A DESIRED SPACECRAFT 

C COORDINATE SYSTEM 

C 

DIMENSION EUC3),CAC3,3),QI(3),QFC3),CFC3),RF(3,3),RCC3,3) 

DIMENSION AC 28, 100), IAC 28, 100), KCLASSL 4, 8 ) , IFSC4) 

DIMENSION NOUTXC 8 ) , NOUTYC 8 ) , N0UT2C8) , N0UTBC8 ) , NRCOUT ( 8 ) 

DIMENSION NOLDX(8),NOLDY(8),NOLDZ(8),NOLDB(8), NRC0LDC8 ) 

EQUIVALENCE ( AC 1 , 1 ) , IAC 1 , 1 ) ) 

COMMON /MDFILE/ I OR, I OW, IOF, IOD, I OB, IOF1ST , I ODIST , IOWIST , IOWIOF 
COMMON /COTRAN/ EU , CA, QI , QF, CF, RF, RC 
COMMON /EPHEMS/ ORBINC, ERAD, IEPDAY, INCREM, INTRVL 
COMMON /FILTOP/ IMETH, ISPEC, IBTBS, SIGMLT, NFLAGK 

COMMON /LIMITS/ DXOL , DYOL , D20L , DBOL , XWINDO, YWINDO,2WINDO, BWINDO, 

* ABVLAT , TRNLAT , ITMGAP 

DATA IFS /22, 23, 24, 25/ 

C 

C INITIALIZE MAGNETIC LATITUDE OUTLIER COUNTER ARRAYS IN THIS INTERVAL 
C 

DO 1 INTCOL =1 , 8 
NOUTXC INTCOL)=0 
NOUTYC INTCOL )=0 
NOUTZC INTCOL )=0 
NOUTBC INTCOL )=0 
NRCOUTC INTCOL )=0 
NOLDXC INTCOL ) =0 
NOLDY C INTCOL ) =0 
NOL DZC INTCOL ) = 0 
NOLDBC INTCOL )=0 
NRCOLDC INTCOL )=0 
C 

C INITIALIZE ARRAY KCLASS FOR CLASSIFICATION COUNTS IN THIS INTERVAL 
C 

DO 1 INTROW=l , 4 
1 KCLASSC INTROW, INTCOL ) =0 
C 

C GENERATE VECTOR CIFS) WHICH PERMUTES MAGNETIC LATITUDE TOLERANCE FLAGS 
C FROM FIT/MAGSAT TO DESIRED SPACECRAFT COORDINATES FOR OUTPUT TAPE 
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c 

IFSCl)=NINTCRCCl,l))X22+NINTCRCCl,2))X23+NINT(RC(l,3))X2<i 
IFS(2)=NINT(RCC2,l))X22+NINTCRCC2,2))XZ3+NINT(RCC2,3))X2<i 
IFS(3)=NINT(RC(3, 1) )X22+NINT(RCC3,2) )X23+NINTCRCC3,3) )X2A 
C 

C PRINT HEADING FOR STEP5 POST-FILTER PROCESSING 
C 

WRITE(6,200) 

200 FORMAT C * 1 * , * XXXXXXXXXKXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXKXXXXXXX • 
X/1X, ’XXXX POST-FILTER PROCESSING xxxx»/ix,'xx 
XXXXXXXXXXKXXXXXXXXXXXXXXXXXXXXXXKXXXXXXXXXXXKXXXXXX * ) 

c 

C BEGIN FINAL DATA MODIFICATION AND OUPUT.- 
C 

C REMIND INPUT UNITS — > IOH REWIND OUTPUT UNITS — > IOF 
C IOD 

c IOB 

C 

REMIND IOM 
REWIND IOF 
REMIND IOD 
REMIND IOB 
C 

C SETUP FOR DATA QUALITY CLASSIFICATION COUNTER KCLASSs 
C 

C KCLASS(1,II) — > STATUS ON UNIT IOF FILTER OUTPUT FOR THIS INTERVAL 

C KCL ASSC 2 , II ) — > STATUS ON UNIT IOB FILTER OUTPUT FOR THIS INTERVAL 

C KCL ASSC 3, II ) — > STATUS OF ENTIRE DATA SETS ON UNITS IOF AND IOB 

C KCL ASSC A » II ) — > STATUS OF ENTIRE DATA SET ON UNIT IOD 

C 

C COUNTER DEFINITIONS: 

NTOPO COUNTS TOTAL RECORDS READ FROM UNIT IOM AND WRITTEN TO UNIT IOF 
C IN TOPOCENTRIC COORDINATES FOR THIS INTERVAL 

C NTOTR COUNTS TOTAL RECORDS READ FROM UNIT IOM AND WRITTEN TO UNIT IOF 
C IN FIT/MAGSAT COORDINATES FOR THIS INTERVAL 

C NSAT COUNTS TOTAL RECORDS WRITTEN TO UNIT IOD IN DESIRED SPACECRAFT 
C COORDINATES FOR THIS INTERVAL 

C NFIT COUNTS TOTAL NON-ZERO PADDED RECORDS WRITTEN TO UNIT IOB FOR 
C THIS INTERVAL 

C NBLK COUNTS TOTAL 100-RECORD BLOCKS WRITTEN IN BINARY FOR FIT INPUT 
C ON UNIT IOB 

C NRIOF COUNTS TOTAL RECORDS EXISTING ON UNIT IOF 

C NRIOD COUNTS TOTAL RECORDS EXISTING ON UNIT IOD 

C NBIOB COUNTS TOTAL NON-ZERO PADDED RECORDS EXISTING ON UNIT IOB 
C 

NTOPO=0 

NTOTR=0 

NSAT=0 

NFIT=0 

NBLK-0 

NRIOF=0 

NRIOD=0 

NBIOB=0 

C 

C NSTART STORES POSITION OF 'FIRST ZERO-PADDED RECORD OF LAST 100-REC0RD 
C BINARY BLOCK EXISTING ON UNIT IOB PRIOR TO THIS RUN. THIS INFORMATION 
C IS USED WHEN APPENDING DATA (SEE BELOW) 

C 

NSTART =1 
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c 

C FINAL DATA OUTPUT VERSION OPTION DEPENDING ON IBTBS 
C 

IF(IBTBS.NE.O) GO TO 30 
C 

C IF IBTBS = 0, CHECK IF CURRENTLY GENERATED OUTPUT DATA HILL BE FIRST 
C DATA CIOF1ST = 1) OR APPENDED DATA (IOF1ST = 0) ON UNIT IOF. 

C IF APPENDED, THEN POSITION FILE MARKER AFTER LAST EXISTING RECORD 
C 

IFCIOFIST.EO.l) GO TO 15 

5 READ( IOF, 201, END=1 0 ) IYR, IDAY, IETIME,GLAT ,GCLAT,GLON,GMLAT , GMLON, 
*ALT, CALT , TX, TY, TZ, TB, DX, DY, DZ, DB, CX, CY, CZ, CB, IDIR, INOTE 

201 FORMAT (12, 14, 16, 7 F7. 2, 6 AX, 12F8 .1,215) 

NRI0F=NRI0F+1 

C 

C UPDATE QUALITY CLASSIFICATION COUNTS OF TOTAL TOPOCENTRIC OUTPUT DATA 
C SET PRESENTLY RESIDING ON UNIT IOF 
C 

KCLASS( 3 , INOTE+1 ) =KCLASS( 3, INOTE+1 )+l 
GO TO 5 

10 BACKSPACE IOF 
C 

C IF IBTBS = 0, HRITE OUT TOPOCENTRIC FORMAT TAPE. NEW UNIT IOF TAPE 
C HAS IDENTICAL INFORMATION AS INPUT UNIT IOW TAPE, EXCEPT UNMODIFIED 
C FIT/MAGSAT MAGNETIC FIELD COMPONENTS ARE OMITTED 

C 

15 READ(IOW,202,END=20) IYR, IDAY, IETIME, GLAT,GCLAT,GLON,GMLAT, GMLON, 
XALT, CALT , BX, BY, BZ, BB, HX, HY, HZ, HB, TX,TY,TZ,TB, DX, DY, DZ, DB, CX, CY, CZ, 
XCB, IDIR, INOTE 

202 FORMAT (I2,IA,I6,7F7 .2, 20 F8. 1,215) 

C 

C DETERMINE UNIT IOW TIME INTERVALS TO BE PROCESSED DURING THIS STEP: 

C 

C IF IOWIOF = 0 --> PROCESS INTRVL ONLY 

C IF IOWIOF = 1 --> PROCESS INTRVL AND PRECEEDING INTERVALS 

C IF IOWIOF = 2 — > PROCESS ALL INTERVALS 

C 

C IF IOWIOF = 0 — > IF CURRENT DAY (IDAY) IS EARLIER THAN EPOCH DAY 

( IEPDAY) , THEN REJECT POINT 

IF(( IOWIOF. EQ.O). AND. ( IDAY. LT.IEPDAY)) GO TO 15 

DETERMINE RELATIVE TIME OF DATA POINT (ICTIME) WITH RESPECT TO 

C BEGINNING OF EPOCH DAY (IEPDAY), THEN DETERMINE ITS TIME INTERVAL (NI) 

C WITH RESPECT TO INTERVAL WIDTH (INCREM). 

C 

ICTIME=(IDAY-IEPDAY)*86400+IETIME 
NI=INT ( ICTIME/INCREM)+1 
C 

C IF IOWIOF = 0 --> IF CURRENT TIME INTERVAL IS LESS THAN INTERVAL OF 
C INTEREST, THEN REJECT POINT 

C 

IF((IOWIOF. EQ.O). AND. (NI.LT. INTRVL)) GO TO 15 
C 

C IF IOWIOF = 0 OR 1 --> IF CURRENT TIME INTERVAL IS GREATER THAN 
C INTERVAL OF INTEREST, THEN REJECT POINT 

C 

IF((IOWIOF.LE.l). AND. (NI.GT. INTRVL)) GO TO 20 
C 

C BEGIN COUNT OF DATA ACCEPTED FROM UNIT IOW 
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C 

NTOPO=NTOPO+1 

UPDATE QUALITY CLASSIFICATION COUNTS OF TOPOCENTRIC OUTPUT DATA SET 

KCL ASSC 1 , INOTE+1 ) =KCLASS( 1 , INOTE+1 ) + l 
C 

C WRITE TOPOCENTRIC DATA SET OUT TO UNIT IOF 
C 

WRITEC IOF, 201 ) IYR, IDAY, IETIME, GLAT, GCLAT, GLON,GMLAT,GMLON, ALT, 
XCALT,TX,TY,TZ,TB,DX,DY,DZ,DB,CX,CY,CZ,CB,IDIR, INOTE 
GO TO 15 
C 

C CALCULATE TOTAL NUMBER OF COMPONENTS (NCOMPF) OUTPUT BY THE FILTER 
C EXCLUDING PADDED TIME-GAP RECORDS 
C 

20 NC0MPF=4X(NT0P0-KCLASSC1,3)) 

C 

C END PROCESSING OF FINAL TOPOCENTRIC FORMAT TAPE. PRINT CLASSIFICATION 
C COUNTS FOR THIS TAPE 
C 

WRITEC 6 , 203) IOF 

203 FORMATC//1X, f <STEP5 TOPOCENTRIC FORMATTED OUTPUT DATA CLASSIFICATI 
*ON ON UNIT M2, *>•) 

WRITEC6,204) ( KCL ASS C 1 , KCL ) , KCL = 1 , 8 ) , NTOPO , NCOMPF 

204 F0RMATC/6X, f FLAGM4X, ’COUNT', 27X, f DESCRIPTIONV/1X, ’ INOTE = 0M4X, 

XI5, 1 -- > NO LIMITATIONS OR CONSTRAINTS V1X, f INOTE = IMAX^IS, 1 — 
*> GROSS-OUTLIER WITH RESPECT TO OBSERVED - COMPUTED FIELDV1X, f IN 
*OTE = 2M4X,I5, f --> PADDED TIME-GAP VALUE f /lX, f IN0TE = 3M4X,I5, 
x f — > B-SPLINE FIT-OUTLIER f /IX, f INOTE = 4M4X,I5,' — > FOURIER F 
XIT-OUTLIERV1X, ’INOTE - 5M4X,I5,' — > COMBINATION B-SPLINE/FOURI 
*ER FIT-OUTLIER'/IX, f INOTE = 6 MAX, 15, f --> GEOCENTRIC LATITUDE LI 
XES OUTSIDE TOLERANCE LEVEL V1X, 1 INOTE = 7 MAX, 15, ■ — > SATELLITE 
XVELOCITY VECTOR DIRECTION IS INDETERMINABLE 1 //IX, ’TOTAL =="> MI 
X5 , 1 RECORDS V/1X, T TOTAL =-==> MI5, 1 COMPONENTS 1 /) 

C 

C ADJUST UNIT IOF CLASSIFICATION COUNTS DUE TO NEWLY APPENDED DATA 
C 

NRIOF=NRIOF+NTOPO 
DO 25 IADD=1,8 

25 KCL ASSC 3, I ADD) =KCLASSC3, 1 ADD)+KCLASS( 1 , 1 ADD) 

C 

C CALCULATE TOTAL NUMBER OF COMPONENTS CNCOMPT) EXISTING ON UNIT IOF 
C EXCLUDING PADDED TIME-GAP RECORDS 
C 

NCOMPT =AX( NTOPO-KCLASSC 3, 3) ) 

C 

C PRINT STATUS OF ENTIRE OUTPUT DATA SET EXISTING ON UNIT IOF 

C 

WRITEC6 , 205) IOF 

205 FORMATC//1X, ’<TOTAL TOPOCENTRIC FORMATTED OUTPUT DATA CLASSIFICATI 
XON EXISTING ON UNIT MI2,*> f ) 

WRITEC 6, 20A) C KCLASSC3, KCL ), KCL = 1 ,8 ) , NRIOF, NCOMPT 
RETURN 

C 

C IF IBTBS = 1 OR 2, CHECK IF CURRENTLY GENERATED OUTPUT DATA WILL BE 
C FIRST DATA CIOFIST = 1) OR APPENDED DATA CI0F1ST = 0) ON UNITS IOF AND 
C I OB , AND FIRST DATA CI0D1ST = 1) OR APPENDED DATA CIOD1ST = 0) ON UNIT 
C IOD ♦ IF APPENDED, THEN POSITION FILE MARKER AFTER LAST EXISTING RECORD 
C 
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30 IF( I0F1ST . EQ . 1 ) GO TO 70 
C 

C POSITION FILE MARKER FOR APPENDING DATA ON UNIT IOF 

C 

AO READ(IOF,206,END=45) IYR, I DAY , IETIME,GLAT , GCLAT, GLON, GMLAT , GMLON, 
*ALT,CALT,PX,PY,PZ,PB,HX,HY, HZ, HB, TX, TY, TZ, TB, DX, DY, DZ, DB, CX, CY, CZ, 
*CB, I DIR, I NOTE# IAX, IAY, IAZ, IAB 
206 FORMAT (12, 14, 16, 7 F7. 2, 20 F8. 1,215, 412) 

NRIOF=NRIOF+l 

C 

C UPDATE QUALITY CLASSIFICATION COUNTS OF TOTAL FIT/MAGSAT OUTPUT DATA 
C SET PRESENTLY RESIDING ON UNIT IOF 
C 

KCLASSC3, INOTE+1 ) =KCLASS( 3, INOTE+1 )+l 
C 

C IF CURRENT POINT IS A PADDED TIME-GAP VALUE (INOTE = 2), THEN DO NOT 
C UPDATE MAGNETIC LATITUDE OUTLIER COUNTS 

C 

IF( INOTE . EQ . 2) GO TO 40 

UPDATE MAGNETIC LATITUDE OUTLIER RECORD COUNTS 

IFUIAX.EQ.O) .OR. (IAY.EQ.O) .OR. (IAZ.EQ.O) . OR . ( IAB . EQ . 0 ) ) 

*NRCOLD( INOTE+1 ) =NRCOLD( INOTE+1 )+l 

OUTLIER COUNTER DEFINITIONS FOR INDIVIDUAL DATA QUALITY FLAGS: 

NOLDX-B FOR ENTIRE UNIT IOF DATA SET IS ANALOGOUS TO NOUTX-B FOR 
CURRENT FILTER OUTPUT DATA SET (SEE DESCRIPTION BELOW) 

TALLY MAGNETIC LATITUDE OUTLIER COMPONENTS EXISTING ON UNIT IOF 


IF(IAX.EQ.O) NOLDXC INOTE+1 )-NOLDX( INOTE+1 )+l 
IF(IAY.EQ.O) NOLDYC INOTE+1 )=NOLDYC INOTE+1 )+l 
IFC IAZ.EQ.O) NOLDZC INOTE+1 )=NOLDZ( INOTE+1 )+l 
IFCIAB.EQ.O) NOLDBC INOTE+1 )=NOLDBC INOTE+1 )+l 
GO TO 40 

45 BACKSPACE IOF 


POSITION FILE MARKER FOR APPENDING DATA ON UNIT IOB 


C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


50 READCIOB, END=60) A 

CHECK THE MODIFIED JULIAN DAY STORED IN FIRST ELEMENT OF EACH RECORD 
OR COLUMN OF THIS 100-RECORD BLOCK (SEE FIT INPUT FORMAT BELOW): 


IF MOD JUL 
IF MOD JUL 


DAY IS NOT ZERO 
DAY IS ZERO 


TOTAL NON-PADDED RECORDS: 
CURRENT RECORD CHECKED: 
PROCESSING ORDER: 


55 


NSTART = 101 
NSTART = NSTART-1 


— > DATA EXISTS ON THE RECORD 

-- > NO DATA EXISTS ON THE RECORD (PADDED) 

NBIOB 

NSfART 

FROM RECORD NUMBER 100 — > 1 SO THAT 
FULL-RECORD CHECK TIME IS MINIMIZED 


C 

C IF ENTIRE BLOCK IS PADDED (NSTART = 0), THEN SET APPEND POSITION AT 
C THE FIRST RECORD, THUS OVERWRITING THE ENTIRE PADDED BLOCK 
C 
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IF( NSTART . EQ . 0) GO TO 65 
C 

C IF THE FIRST NSTART RECORDS ARE NOT ZERO, THEN SET APPEND POSITION AT 
C NEXT RECORD AFTER THESE, THUS OVERWRITING THE PADDED PORTION 
C 

IFCIAC1, NSTART) .NE.O) GO TO 65 
GO TO 55 
C 

C ENTRY POSITION IF END OF FILE MARK IS ENCOUNTERED, TREAT THE SAME AS 
C IF ENTIRE PADDED BLOCK HAS BEEN ENCOUNTERED 

C 

60 NSTART=0 
C 

C UPDATE COUNT OF NON-ZERO RECORDS EXISTING ON UNIT IOB 

C 

65 NBIOB=NBIOB+NSTART 
C 

C IF A FULL NON-ZERO 100-RECORD BLOCK WAS ENCOUNTERED, THEN READ AND 
C CHECK NEXT BLOCK UNTIL A BLOCK IS FOUND WITH PADDED VALUES OR AN END 
C OF FILE MARK IS ENCOUNTERED 
C 

I F( NSTART . EQ . 100) GO TO 50 
C 

C ADJUST NSTART FROM LAST NON-ZERO RECORD POSITION TO APPEND POSITION 

C 

NSTART =NSTART+1 
C 

C SET UNIT IOB FILE POSITION MARKER TO REWRITE LAST DATA BLOCK 
C 

BACKSPACE IOB 

70 IFC ( IBTBS . NE. 2) . OR. ( I ODIST . EQ . 1 ) ) GO TO 85 

C 

C POSITION FILE MARKER FOR APPENDING DATA ON UNIT IOD 

C 

75 READC IOD, 206 , END=80) IYR, IDAY, IETIME,GLAT ,GCLAT , GLON, GMLAT, GMLON, 
*ALT, CALT , UX, UY, UZ, UB, WX, WY, WZ, WB , TX, TY, TZ, TB, DX, DY, DZ# DB, CX,CY,CZ> 
*CB , I DIR, I NOTE, IAX, IAY, IAZ, IAB 
NRIQD=NRIQD+1 
C 

C UPDATE QUALITY CL ASSIFICATION COUNTS OF TOTAL DESIRED SPACECRAFT 
C OUTPUT DATA SET PRESENTLY RESIDING ON UNIT IOD 

C 

KCLASSC A, INOTE+1 ) =KCL ASS( 4, INQTE+1 )+l 
GO TO 75 

80 BACKSPACE IOD 
C 

C IF IBTBS = I OR 2, WRITE OUT FIT/MAGSAT FORMAT TAPES AND IF IBTBS = 2, 
C WRITE OUT DESIRED SPACECRAFT FORMAT TAPE. BINARY OUTPUT IS WRITTEN TO 
C UNIT IOB IN BLOCKS OF 100 RECORDS. 

C 

C INITIALIZE COLUMN NUMBER NSTART THROUGH NUMBER 100 OF BLOCK STORAGE 
C ARRAYS A AND IA FOR GENERATION OF NEXT DATA BLOCK 
C 

85 DO 90 II=NSTART, 100 
DO 90 J J = 1 , 28 
IAC J J , II )-0 
90 A( J J , II ) =0 . 0 

PROCESSING FOR 100-RECORD DATA BLOCKS IN THIS RUN: 
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C FIRST BLOCK — > FIRST 101 - NSTART RECORDS FROM INPUT UNIT IOW 
C NSTART - 1 RECORDS ALREADY EXIST FROM UNIT IOB 
C SUBSEQUENT BLOCKS — > NEXT 100 RECORDS FROM INPUT UNIT IOW 

C 


DO 95 II=NSTART,100 

100 READ(IOW,202,END=115) IYR, IDAY, IETIME, GLAT,GCLAT,GLON,GML AT, GMLON, 
*ALT,CALT,BX,BY,BZ,BB,OX,OY,OZ,OB,TX,TY,TZ,TB,DX,DY,DZ,DB,CX,CY,CZ, 
*CB,IDIR,INOTE 


C 

C DETERMINE 
C 

C IF IOWIOF 
C IF IOWIOF 
C IF IOWIOF 
C 

C IF IOWIOF 

C 

C 


UNIT IOW TIME INTERVALS TO BE PROCESSED DURING THIS STEP 
= 0 — > PROCESS INTRVL ONLY 

= 1 — > PROCESS INTRVL AND PRECEEDING INTERVALS 
= 2 — > PROCESS ALL INTERVALS 

= 0 — > IF CURRENT DAY (IDAY) IS EARLIER THAN EPOCH DAY 
(IEPDAY), THEN REJECT POINT 


IF(dOWIOF.EQ.O). AND. (IDAY. LT. IEPDAY)) GO TO 100 


C 

C DETERMINE RELATIVE TIME OF DATA POINT (ICTIME) WITH RESPECT TO 
C BEGINNING OF EPOCH DAY (IEPDAY), THEN DETERMINE ITS TIME INTERVAL (NI) 
C WITH RESPECT TO INTERVAL WIDTH (INCREM). 

C 

ICTIME=( I DAY- IEPDAY) *86 A 00+ IETIME 
NI=INTCICTIME/INCREM)+1 
C 

C IF IOWIOF = 0 --> IF CURRENT TIME INTERVAL IS LESS THAN INTERVAL OF 
C INTEREST, THEN REJECT POINT 

C 

IF((IOWIOF.EQ.O). AND. (NI.LT. INTRVL)) GO TO 100 
C 

C IF IOWIOF = 0 OR 1 --> IF CURRENT TIME INTERVAL IS GREATER THAN 
C INTERVAL OF INTEREST, THEN REJECT POINT 

C 

IF(dOWIOF.LE.l). AND. (NI.GT. INTRVL)) GO TO 115 
C 

C BEGIN COUNT OF DATA ACCEPTED FROM UNIT IOW 

C 

NT0TR=NT0TR+1 


C 

C UPDATE QUALITY CLASSIFICATION COUNTS OF IOW INPUT AND IOF OUTPUT DATA 

C 

KCLASSd , INOTE+1 )=KCLASS( 1 , INOTE+1 )+l 
C 

C PERFORM TRANSFORMATION FROM TOPOCENTRIC TO FIT/MAGSAT TO THE DESIRED 
C SPACECRAFT COORDINATE SYSTEMS IN THE FOLLOWING ORDER: 

C 


c 

FOR 

IDIR = -1 

OR 1: 

TOPOCENTRIC 


FIT/MAGSAT 


DESIRED 

c 

c 

Cl) 

OBSERVED 

COMPONENTS: 

CTX,TY,TZ) 

— > 

(PX,PY,PZ) 

> 

(UX,UY,UZ) 

c 

c 

C 2) 

RESIDUAL 

COMPONENTS: 

CDX,DY,DZ) 

— > 

(HX, HY,HZ) 

> 

CWX,WY,WZ) 

c 

c 

FOR 

IDIR = 0: 


FIT/MAGSAT 


FIT/MAGSAT 


DESIRED 

c 

c 

Cl) 

OBSERVED 

COMPONENTS: 

CBX,BY,BZ) 

— > 

(PX,PY,PZ) 

> 

CUX,UY,UZ) 

c 

C 2) 

RESIDUAL 

COMPONENTS: 

C 0, 0, 0) 

— > 

( 0 , 0 , 0) 

> 

C 0, 0, 0) 


C 

IF(IDIR.NE.O) CALL BTTOBS(GCLAT , IDIR, TX, TY, TZ» PX, PY, PZ, PB, 
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* UX,UY, UZ, UB) 

IF(IDIR.EQ.O) CALI BTTOBSCGCLAT , IDIR, BX, BY, BZ, PX, PY, PZ, PB, 

* UX,UY,UZ,UB) 

CALL BTTOBSCGCLAT, IDIR, DX, DY, DZ, HX, HY, HZ, HB, WX, WY, WZ,WB) 

C 

C IF CURRENT DATA POINT IS A TIME-GAP PADDED VALUE (INOTE = 2), THEN: 

C 

C OMIT FROM — > BINARY UNIT IOB FINAL OUTPUT TAPE 
C INCLUDE IN — > FORMATTED UNIT IOF FINAL OUTPUT TAPE 
C 

I F( INOTE . EQ . 2) GO TO 105 
C 

C UPDATE QUALITY CLASSIFICATION COUNTS OF UNIT IOB FIT/MAGSAT OUTPUT 

C 

KCLASSC2, INOTE+1 )=KCLASSC2, INOTE+1 )+l 
NFIT=NFIT+1 
C 

C STORE CURRENT DATA POINT INFORMATION, RECORD II OF CURRENT 100 RECORD 
C BLOCK, IN COLUMN II OF STORAGE ARRAYS A AND IA ACCORDING TO THE FIT 
C INPUT FORMAT: 

C 

C I AC 1,11) = MODIFIED JULIAN DAY 

C IAC 2, II ) = MILLISECONDS OF DAY 

C AC 3, II ) = NOT USED 

C AC A , II ) = FRACTION OF DAY 

C ACS, II) = TIME IN YEARS FROM 1900 

C AC 6 , 1 1 ) = GEOCENTRIC LATITUDE 

C AC7 , I I ) = LONGITUDE 

C AC 8 , 1 1 ) = NOT USED 

C AC 9 , II ) = NOT USED 

C AC 1 0 , II ) = NOT USED 

C AC 1 1 , 1 1 ) = SATELLITE X-AXIS COMPONENT IN FIT/MAGSAT COORDINATES 

C AC 12 , II ) = SATELLITE Y-AXIS COMPONENT IN FIT/MAGSAT COORDINATES 

C AC 13, II) = SATELLITE Z-AXIS COMPONENT IN FIT/MAGSAT COORDINATES 

C AC 1 A , II ) = SCALAR INTENSITY 

C IAC 15, II) = GEOCENTRIC ALTITUDE (METERS) ABOVE ERAD CKM) 

C AC 16 , II ) = NOT USED 

C AC 17 , II ) = NOT USED 

C IAC 18,11) = DATA QUALITY CLASSIFICATION FLAG CINOTE) 

C IAC 19,11) = 0 

C IAC 20 , II ) = SATELLITE VELOCITY VECTOR DIRECTION CIDIR) 

C IAC 21 , II ) = 0 

C IAC 22, II ) = MAGNETIC LATITUDE OUTLIER FLAG FOR SATELLITE X-AXIS 

C IAC 23, II ) = MAGNETIC LATITUDE OUTLIER FLAG FOR SATELLITE Y-AXIS 

C IAC 24, II) = MAGNETIC LATITUDE OUTLIER FLAG FOR SATELLITE Z-AXIS 

C IAC25, II ) = MAGNETIC LATITUDE OUTLIER FLAG FOR SCALAR INTENSITY 

C AC 26 , II ) = NOT USED 

C AC 27 , II ) = NOT USED 

C AC 28 , II ) = NOT USED 

C 

C ASSIGN ARRAYS A AND IA NOW FOR CURRENT RECORD II 
C 

IAC 1 , I I ) =IDAY 

IAC2,II)=IETIME*1000 

AC4,II)=REALC IETIME)/86400 . 0 

AC5,II)=REALCIYR)+CREAL( IDAY)+A( 4, II))/ 36 5.0 

AC6 , II ) =GCLAT 

AC7 , I I ) =GLON 

AC 1 1 , II ) =PX 

A C 12, 1 1 ) =PY 
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A(13,II)=PZ 
A( 14, II ) =PB 

IA(15,II)=INT( (CALT-ERAD)XlOOO . 0) 

IAC18,II)=IN0TE 
IA(20, II )=IDIR 
C 

C CHECK MAGNETIC LATITUDE AGAINST GIVEN MAGNETIC LATITUDE TOLERANCE 
C WINDOW FOR EACH VECTOR AND SCALAR COMPONENT USING THE FOLLOWING FLAGS 
C 

C IF OUTSIDE WINDOW — > IA = 0 
C IF INSIDE WINDOW — > IA = 2 
C 

C OUTLIER COUNTER DEFINITIONS FOR INDIVIDUAL DATA QUALITY FLAGS * 

C 

C NOUTXCI) COUNTS TOTAL FIT/MAGSAT X MAGNETIC LATITUDE OUTLIERS 

C NOUTY(I) COUNTS TOTAL FIT/MAGSAT Y MAGNETIC LATITUDE OUTLIERS 

C NOUTZ(I) COUNTS TOTAL FIT/MAGSAT Z MAGNETIC LATITUDE OUTLIERS 

C NOUTB(I) COUNTS TOTAL FIT/MAGSAT B MAGNETIC LATITUDE OUTLIERS 

C NRCOUT ( I ) COUNTS TOTAL RECORDS WHICH HAVE AT LEAST ONE COMPONENT 
C OUTSIDE THE MAGNETIC LATITUDE TOLERANCE LEVEL 

C 

C (WHERE I = 1-8 CORRESPONDS TO INOTE = 0-7) 

C 

AGMLAT =ABS(GMLAT) 

C 

C ASSIGN MAGNETIC OUTLIER FLAGS 
C 

IF( AGMLAT . LE. XWINDO) IA(22,II)=2 
IFCAGMLAT. LE.YWINDO) IAC23,II)=2 
I F( AGMLAT . LE .ZWINDO) IA(24,II)=2 
I F( AGMLAT . LE . BWINDO) IAC25,II)=2 
C 

C UPDATE MAGNETIC LATITUDE OUTLIER RECORD COUNTS 
C 

IFUAGMLAT.GT. XWINDO) .OR. (AGMLAT. GT.YWINDO) .OR. (AGMLAT . GT . ZWINDO) 
X . OR . ( AGMLAT . GT . BWINDO) ) NRCOUT( INOTE+1 ) =NRCOUT( INOTE+1 )+l 
C 

C UPDATE MAGNETIC LATITUDE OUTLIER COMPONENT COUNTS 
C 

IF( AGMLAT .GT . XWINDO) NOUTX( INOTE+1 )=NOUTX( INOTE+1 )+l 
IF( AGMLAT .GT . YWINDO) NOUTY( INOTE+1 )=NOUTY( INOTE+1 )+l 
IF( AGMLAT . GT . ZWINDO) NOUTZ( INOTE+1 )=NOUTZ( INOTE+1 >+l 
IF( AGMLAT. GT. BWINDO) NOUTB( INOTE+1 )=NOUTB( INOTE+1 )+l 

C 

C ENTRY POINT HERE IF CURRENT POINT IS PADDED TIME-GAP VALUE 
C 

105 IF( IBTBS . NE . 2) GO TO 110 
C 

C IF IBTBS = 2, THEN WRITE CURRENT DATA POINT INFORMATION TO UNIT IOD 
C IN THE DESIRED SPACECRAFT COORDINATES 
C 

NSAT =NSAT+1 

WRITE( IOD, 206 ) IYR, IDAY, IETIME, GLAT , GCLAT, GLON, GMLAT,GMLON, ALT , 
*CALT,UX,UY,UZ,UB,WX,WY,WZ,WB,TX,TY,TZ,TB,DX,DY,DZ,DB,CX,CY,CZ,CB, 
XIDIR, INOTE, (IA(IFS(KK),II),KK=1,4) 

C 

C WRITE CURRENT DATA POINT INFORMATION TO UNIT IOF IN THE FIT/MAGSAT 
C COORDINATES, INCLUDING DATA FLAGS FOR THE INDIVIDUAL COMPONENTS 
C 

110 WRITE ( IOF, 206 ) IYR, IDAY, IETIME, GLAT, GCLAT, GLON, GMLAT,GML ON, ALT, 
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*CALT,PX,PY,PZ,PB,HX,HY,HZ,HB,TX,TY,TZ,TB,DX,DY,DZ,DB,CX,CY,CZ,CB, 
*IDIR,INOTE, CIACKK,II),KK=22,25) 

C 

C IF CURRENT POINT IS PADDED TIME-GAP VALUE, THEN READ NEXT RECORD ON 
C UNIT IOW, BUT DO NOT PROGRESS TO NEXT RECORD OF DATA BLOCK A 
C 

IF( INOTE . EQ . 2) GO TO 100 
C 

C IF CURRENT POINT IS NOT A TIME-GAP VALUE, THEN PROGRESS TO NEXT 
C RECORD OF DATA BLOCK A 
C 

95 CONTINUE 
C 

C WRITE FULL 100 RECORD DATA BLOCK TO BINARY UNIT I OB 

C 

NBLK=NBLK+1 
WRITE(IOB) A 
IFCNBLK.GT.I) GO TO 85 
C 

C DETERMINE NUMBER OF NON-ZERO (NOZERO) AND PADDED-ZERO (NPAD) RECORDS 
C THAT OCCURRED ON LAST 100-RECORD BLOCK OF UNIT IOB PRIOR TO THIS RUN 

C 

NPAD=101-NSTART 

NOZERO=NSTART-l 

C 

C SET RECORD APPEND POSITION TO NSTART = 1 FOR BLOCKS SUBSEQUENT TO THE 
C FIRST BLOCK SO THAT A FULL 100 RECORDS MAY BE WRITTEN TO THEM 

C 

NSTART=1 
GO TO 85 
C 

C WRITE FINAL PARTIAL 100 RECORD DATA BLOCK TO BINARY UNIT IOB 

C 

115 NBLK=NBLK+1 
WRITE(IOB) A 
C 

C CALCULATE TOTAL NUMBER OF COMPONENTS (NCOMPF) OUTPUT BY THE FILTER 
C EXCLUDING PADDED TIME-GAP RECORDS 
C 

NC0MPF=4X(NT0TR-KCLASS(1,3)) 

C 

C PRINT QUALITY CLASSIFICATION STATUS OF UNIT IOF FIT/MAGSAT OUTPUT 
C 

WRITE(6 , 207 ) IOF 

207 F0RMAT(//1X, ’<STEP5 FIT/MAGSAT FORMATTED OUTPUT DATA CLASSIFICATIO 
#N ON UNIT ',12, •>’) 

WRITE( 6 , 204 ) ( KCL ASS C 1 , KCL ) , KCL = 1 , 8 ) , NTOTR, NCOMPF 
C 

C PRINT QUALITY CLASSIFICATION STATUS OF UNIT IOB FIT/MAGSAT OUTPUT 
C 

WRITE(6,208) IOB 

208 F0RMAT(//1X, '<STEP5 FIT/MAGSAT BINARY OUTPUT DATA CLASSIFICATION 0 
*N UNIT ’,12, •>') 

WRITE! 6 , 204 ) ( KCLASSC 2, KCL ) , KCL = 1 , 8 ) , NFIT, NCOMPF 
PRINT WRITTEN RECORD TOTALS FOR EACH OUTPUT DATA SET TYPE 

WRITE(6 ,209) NTOTR, IOF, NSAT, IOD, NFIT, IOB, NBLK, IOB 

209 F0RMAT(//1X, ’OUTPUT RECORD SUMMARY : ’//IX, ’TOTAL ====> ’,15,’ FORM 

KATTED FIT/MAGSAT RECORDS WRITTEN TO UNIT *, I2//1X, ’TOTAL ====> », 
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*15,’ FORMATTED DESIRED RECORDS WRITTEN TO UNIT ', I2//1X, * TOTAL === 
*=> ',15,* NON-ZERO PADDED RECORDS WRITTEN TO UNIT * , I2//1X, 'TOTAL 

* ====> ',15,' BINARY 100-RECORD BLOCKS WRITTEN TO UNIT ’,12/) 

C 

C PRINT NUMBER OF PADDED RECORDS OVERWRITTEN (BY DATA GENERATED IN THIS 
C RUN) AND NUMBER OF RECORDS ALREADY EXISTING ON FIRST lOO-RECORD DATA 
C BLOCK TRANSMITTED TO UNIT IOB DURING THIS RUN 
C 

WRITE( 6 ,210) NOZERO, NPAD 

210 FORMATC20X, ’TOTAL ====> ',15,' PREVIOUSLY EXISTING RECORDS INCORP 

XORATED IN FIRST lOO-RECORD DATA BLOCK'//20X, 'TOTAL ====> ',15,' R 

XECORDS GENERATED DURING THIS INTERVAL INCORPORATED IN FIRST 100-RE 
XCORD DATA BLOCK*/) 

C 

C PRINT MAGNETIC LATITUDE OUTLIER HEADING 
C 

WRITEC6 , 211 ) 

211 FORMATC//1X, 'MAGNETIC LATITUDE OUTLIER BREAKDOWN BY FLAGS : *//6X, ' F 
*LAG* , 1 OX, * X OUTLIERS' , AX, *Y OUTLIERS ' , AX, 'Z OUTLIERS' , AX, 'B OUTLIE 
XRS' ,6X, 'COMPONENTS' ,4X, 'RECORDS'/) 

C 

C MAGNETIC LATITUDE OUTLIER COUNTER DEFINITIONS: 

C 

C NXO COUNTS TOTAL NUMBER OF MAGNETIC LATITUDE X OUTLIERS 

C NYO COUNTS TOTAL NUMBER OF MAGNETIC LATITUDE Y OUTLIERS 

C NZO COUNTS TOTAL NUMBER OF MAGNETIC LATITUDE Z OUTLIERS 

C NBO COUNTS TOTAL NUMBER OF MAGNETIC LATITUDE B OUTLIERS 

C NCO COUNTS TOTAL NUMBER OF MAGNETIC LATITUDE OUTLIER COMPONENTS 

C NFOUT COUNTS TOTAL NUMBER OF MAGNETIC LATITUDE OUTLIERS FOR 
C PARTICULAR DATA QUALITY FLAG 

C NRCTOT COUNTS TOTAL NUMBER OF RECORDS CONTAINING MAGNETIC LATITUDE 
C OUTLIERS 

C 

NX0=0 
NYO=0 
NZO=0 
NBO=0 
NRCTOT = 0 

PRINT MAGNETIC LATITUDE OUTLIER COUNTS PER EACH DATA QUALITY FLAG 

DO 120 IN=1,8 
NF=IN-1 

NXO=NXO+NOUTX( IN) 

NYO=NYO+NOUTY( IN) 

NZO=NZO+NOUTZ( IN) 

NBO=NBO+NOUTB( IN) 

NRCTOT =NRCTOT +NRCOUT (IN) 

NFOUT =NOUTX( IN)+NOUTY( IN)+NOUTZ( IN)+NOUTB( IN) 

120 WRITE(6 ,212) NF, NOUTX( IN) , NOUTY( IN) , NOUTZ( IN) , NOUTB( IN) , NFOUT, 
XNRCOUT (IN) 

212 FORMAT (IX, 'I NOTE = ',11,' — > ',4114,' — > * , 5X, 15, 6X, 15) 

NCO COUNTS TOTAL NUMBER OF MAGNETIC LATITUDE OUTLIER COMPONENTS 

NCO=NXO+NYO+NZO+NBO 
C 

C PRINT MAGNETIC LATITUDE OUTLIER COUNTS PER EACH COMPONENT 
C 

WRITE(6 , 213) NXO, NYO, NZO, NBO, NCO, NRCTOT 
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213 F0RMAT(/1X, •TOTAL — > ’,<*114,' = = > ' ,5X, I5,6X, 15///) 

C 

C BEGIN PROCESSING STATUS ON ENTIRE DATA SETS EXISTING ON UNITS IOF, 

C IOD, AND IOB 
C 

C ADJUST OUTPUT UNIT CLASSIFICATION COUNTS DUE TO NEWLY APPENDED DATA 
C 

NRIOF=NRIOF+NTOTR 
NRIOD=NRIOD+NSAT 
DO 125 IADD=1,8 

KCL ASSC 3, IADD) =KCLASS( 3, 1 ADD)+KCL ASSC 1 , IADD) 

125 KCLASSC 4, IADD)=KCLASS( 4, IADD )+KCL ASSC 1 , I ADD) 

C 

C CALCULATE TOTAL NUMBER OF COMPONENTS CNCOMPT) EXISTING ON UNIT IOF 
C EXCLUDING PADDED TIME-GAP RECORDS 
C 

NCOMPT = 4*( NRIOF-KCLASSC 3, 3) ) 

C 

PRINT STATUS OF ENTIRE OUTPUT DATA SET EXISTING ON UNIT IOF 
WRITEC6 , 214) IOF 

214 FORMATC//1X, ’ <T0TAL FIT/MAGSAT FORMATTED OUTPUT DATA CLASSIFICATIO 
*N EXISTING ON UNIT ’,I2, f > f ) 

WRITE( 6 , 204) ( KCLASSC 3, KCL ) , KCL=1 , 8 ) , NRIOF, NCOMPT 

C 

C CALCULATE TOTAL NUMBER OF 100-RECORD BLOCKS EXISTING ON UNIT IOB 
C AFTER APPENDING NEW DATA AND ELIMINATING PADDED ZEROS 

C 

NBIOB-NBIOB+NFIT 
NBLK=INT (NBIOB/IOQ) 

IFCM0D(NBI0B,1QQ) .GT.O) NBLK=NBLK+1 

C 

C ADJUST UNIT IOB OUTPUT DATA QUALITY CLASSIFICATION STATUS BY OMITTING 
C PADDED TIME-GAP VALUE COUNTS STORED IN KCLA$SC3,3) 

C 

KCLASSC3, 3)=0 
C 

C PRINT STATUS OF ENTIRE OUTPUT DATA SET EXISTING ON UNIT IOB 

C 

WRITEC6 , 215) IOB 

215 FORMATC//1X, ’<TOTAL FIT/MAGSAT BINARY OUTPUT DATA CLASSIFICATION E 
EXISTING ON UNIT *,I2, f > f ) 

WRITEC6 , 204) ( KCLASSC 3, KCL ), KCL = 1 ,8 ), NBIOB, NCOMPT 

C 

C PRINT WRITTEN RECORD TOTALS FOR EACH OUTPUT DATA SET TYPE 
C 

WRITEC6 , 209 ) NRIOF, IOF, NRIOD, IOD, NBIOB, IOB, NBLK, IOB 
C 

C PRINT MAGNETIC LATITUDE OUTLIER HEADING 
C 

WRITEC6 , 211 ) 

C . 

C MAGNETIC LATITUDE OUTLIER COUNTER DEFINITIONS j 
C 

C NXO-NRCTOT ARE ANALOGOUS FOR THIS TOTAL OUTPUT STATUS OF UNIT IOF 
C (SEE DESCRIPTION ABOVE) THESE ARE CUMULATIVE SUMS FROM THE PRESENT 
C FILTER OUTPUT COUNTS AND THE COUNTS MADE ON DATA WHICH EXISTED PRIOR 
C TO THIS RUN ON UNIT IOF 
C 

C PRINT MAGNETIC LATITUDE OUTLIER COUNTS PER EACH DATA QUALITY FLAG 
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DO 130 IN=1,8 
NF=IN-1 

NRCTOT =NRCT0T+NRC0LD( IN) 

NRCOLDC IN)=NRC0LD( IN)+NRC0UT (IN) 

NX0=NX0+N0LDX( IN) 

NY0=NY0+N0LDY( IN) 

NZ0=NZ0+N0LDZ( IN) 

NB0=NB0+N0LDB( IN) 

NOLDXC IN) =NOLDX( IN )+N0UTX( IN) 

NOLDYC IN)=NOLDYCIN)+NOUTY( IN) 

NOLDZC IN) =NOLDZ( IN)+N0UTZC IN) 

NOLDBC IN) =NOLDB( IN )+N0UTB( IN) 

NFOUT =N0LDX( IN)+N0LDY( IN)+N0LDZC IN)+N0LDB( IN) 

130 NRITEC6 , 212) NF, NOLDXC IN) , NOLDY( IN) , NOLDZC IN) , NOLDB(IN) , NFOUT, 
XNRCOLD(IN) 

NCO COUNTS TOTAL NUMBER OF MAGNETIC LATITUDE OUTLIER COMPONENTS 
NCO=NXO+NYO+NZO+NBO 

PRINT MAGNETIC LATITUDE OUTLIER COUNTS PER EACH COMPONENT 

WRITEC6 , 213) NXO, NYO , NZO, NBO, NCO, NRCTOT 
C 

C PRINT STATUS OF ENTIRE OUTPUT DATA SET EXISTING ON UNIT IOD ONLY IF 
C DESIRED SPACECRAFT OUTPUT WAS PRODUCED DURING THIS RUN CIBTBS = 2) 

C 

IFCIBTBS.NE.2) RETURN 
C 

C CALCULATE TOTAL NUMBER OF COMPONENTS (NCOMPD) EXISTING ON UNIT IOD 
C EXCLUDING PADDED TIME-GAP RECORDS 
C 

NC0MPD=A*(NRI0D-KCLASSC4,3)) 

C 

C PRINT STATUS OF ENTIRE OUTPUT DATA SET EXISTING ON UNIT IOD 
C 

WRITE( 6 , 216 ) IOD 

216 FORMATC//1X, '<T0TAL DESIRED SPACECRAFT FORMATTED OUTPUT DATA CLASS 
XIFICATION EXISTING ON UNIT ’ ,12, '>*) 

WRITEC 6 , 204 ) < KCLASS( A , KCL ) , KCL = 1 , 8 ) , NRIOD, NCOMPD 

RETURN 

END 

SUBROUTINE BTT0BS( GCLAT, IDIR, EX, EY, EZ, FX, FY, FZ, FB, SX, SY, SZ, SB ) 

C 

C SUBROUTINE TO TRANSFORM MAGNETIC FIELD COMPONENTS FROM TOPOCENTRIC 
C TO FIT/MAGSAT SPACECRAFT-FIXED TO DESIRED SPACECRAFT-FIXED BY 
C PERFORMING: 

C 

C BS=RC*ST*BT 

C 

C WHERE BS = FIELD COMPONENTS IN DESIRED SPACECRAFT COORDINATES 
C RC = ROTATION MATRIX FROM FIT/MAGSAT TO BS COORDINATES 

C ST = ROTATION MATRIX FROM GEOCENTRIC TO FIT/MAGSAT COORDINATES 

C BT = FIELD COMPONENTS IN CARTESIAN TOPOCENTRIC COORDINATES 

C 

C MATRIX ST = TS' HAS THE FOLLOWING FORM: 

C 

C ST = ( SIN( ALPHA )/COS( GCLAT) tCOS( ALPHA )*SIN( DELTA) 0 ) 

C ( 0 0 1 ) 
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C C #COS( ALPHA )XSIN( DELTA) -SINCALPHA)/COS(GCLAT) 0 ) 

C 

C WHERE TS' = INVERSE OF MATRIX TS = TRANSPOSE OF MATRIX TS 

C ALPHA = NEGATIVE COMPLEMENT OF ORBIT INCLINATION 

C GCLAT = GEOCENTRIC LATITUDE 

C DELTA = ARCOSCTANCGCLAT)*TAN( ALPHA)) 

C « = + FOR ASCENDING AND - FOR DESCENDING SATELLITE DATA 

C 

C BS = (SX,SY,SZ) WHERE SX, SY, AND SZ ARE THE DESIRED SPACECRAFT 
C COMPONENTS 

C 

C BT = C EX, EY , EZ) WHERE EX, EY, AND EZ ARE THE CONVENTIONAL TOPOCENTRIC 
C COMPONENTS, THAT IS, (-BTHETA, BPHI, -BRHO) 

C 

REAL*8 COSLAT , SINALP , COSALP, SINDEL , SADCL , CAMSD, DTR 
DIMENSION EUC3),CA(3,3),QI(3),QFC3),CFC3),RFC3,3),RCC3,3) 

COMMON /EPHEMS/ ORBINC, ERAD, IEPDAY, INCREM, INTRVL 
COMMON /COTRAN/ EU, CA , 01 , QF, CF, RF, RC 

CALCULATE DEGREES-TO-RADIANS CONVERSION 
C 

DTR=3. 141592653D0/180 . DO 
C 

C IF SATELLITE VELOCITY DIRECTION IS INDETERMINABLE (IDIR = 0), THEN 
C NO TOPOCENTRIC COMPONENTS HAVE BEEN CALCULATED. SIMPLY USE ORIGINAL, 

C UNMODIFIED COMPONENTS IN FIT/MAGSAT COORDINATES DETERMINED IN STEP1 
C AS THE OUTPUT FIELD COMPONENTS IN STEP5 BY PERFORMING: 

C 

C FS=BT 

C 

C BT = ( EX, EY , EZ) WHERE EX, EY, AND EZ ARE THE ORIGINAL, UNMODIFIED 
C FIT/MAGSAT COMPONENTS 

C 

IF(IDIR.NE.O) GO TO 10 
FX=EX 
FY=EY 
FZ=EZ 
GO TO 20 
C 

C SATELLITE VELOCITY DIRECTION HAS BEEN DETERMINED AND TOPOCENTRIC FIELD 
C COMPONENTS HAVE BEEN GENERATED FOR THIS DATA POINT 

C 

C PERFORM: FS=ST*BT 

C 

C FS = C FX , FY , FZ ) WHERE FX, FY, AND FZ ARE THE FIT/MAGSAT SPACECRAFT 
C COMPONENTS, WHICH ARE PASSED BACK TO STEP5 FOR FURTHER USE 

C 

C DETERMINE NEGATIVE COMPLEMENT ALPHA OF ORBIT INCLINATION ANGLE ORBINC 

C 

10 ALPHA=ORBINC-90 . 0 
C 

C DETERMINE NEEDED TRIGONOMETRIC FUNCTIONS OF GCLAT, ALPHA, AND DELTA 

C 

COSLAT=DCOS( DBLE(GCLAT)XDTR) 

SINALP=DSIN( DBL EC ALPHA )*DTR) 

COSALP=DCOS( DBL EC ALPHA )XDTR) 

SINDEL =DSIN( DACOSC DT AN (DBL EC GCLAT )XDTR)*DTAN( DBL EC ALPHA )*DTR) ) ) 
SADCL =SINAL P/COSLAT 
CAMSD=COSALP*SINDEL 
IFCIDIR.EQ.-l) GO TO 30 
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PERFORM TRANSFORMATION IF SATELLITE IS ASCENDING 

FX=EX*SADCL+EYXCAMSD 
FZ=EXXCAMSD-EYXSADCL 
GO TO AO 
C 

C PERFORM TRANSFORMATION IF SATELLITE IS DESCENDING 
C 

30 FX=EXXSADCL-EYXCAMSD 
FZ=-EXXCAMSD-EYXSADCL 
AO FY=EZ 
C 

C PERFORM: BS=RCXFS 

C 

20 SX=RC( 1 , 1 )XFX+RC(1 , 2JXFY+RCC 1 , 3)XFZ 
SY=RC(2,1)XFX+RC(2,2)XFY+RC(2,3)XFZ 
SZ=RC(3, 1)XFX+RC(3,2)XFY+RC(3,3)XFZ 
C 

C COMPUTE SCALAR FIELD VALUES IN BOTH FIT/MAGSAT AND DESIRED SPACECRAFT 
C COORDINATES 
C 

FB=SQRT( FXXFX+FYXFY+FZXFZ) 

SB=SQRT ( SXXSX+SYXSY+SZXSZ) 

RETURN 

END 
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SUBROUTINE BSPLYNCTS, TF,N, H,T, ICOV , I COR, NDCOVM, INTERP , NDERV, I SHOW, 
*IPRINT, INTV, KNTADJ,ITERMX,LGRMAX, EPS, NOBS, KO,EKNOTS, FREQ, X,S,SIG, 
*V, COEF, D, WTRMS , GSIG, RESID, XINTRP ) 

IMPLICIT REAL *8 C A-H , O-Z) 

DIMENSION XC 500 ), SC 500 ),COEFC 50 0), KSKIPC 500), ELAMC 500), DC 13000) 
DIMENSION VC 5, 500) , EKNOTSC500 ) , SIGC 500 ) , GSIGC5, 500) ,RESID( 500) 
DIMENSION FREQC500) 

INTEGER H,H2N,T 

LDV = 1 

LCV = 0 

LDC=1 

LCR=0 

NSHOW=0 

NPRINT=0 

MH=H 

IFCN.EQ.O) H=0 
IFCN.LT.l) GO TO 38 
NM1 =N~1 

IFCNDERV.LE.NM1) GO TO 38 
WRITEC6,274) NM1 

274 FORMATC1X, ***** ATTENTION: NDERV MUST NOT EXCEED f ,I2, f ****•) 

STOP 

38 DO 1 1=1, N 
ELAMC I ) =TS 
1 ELAMC N+H+I ) =TF 
DO 50 11=1, H 

50 ELAMC II+N) =EKNOTSC II ) 

DO 800 NEX=1,H 

800 KSKIPC NEX) = 0 
KS = KO 
IDIV=10 

801 KNUM=MODCKS, IDIV) 

KS=KS/IDIV 

IFCKNUM.EQ.O) IDIV=IDIV*10 
IFCKNUM.NE.O) KSKIPC KNUM)=1 
IFCKS.EQ.O) GO TO 802 
GO TO 801 

802 NDERVP=NDERV+1 
NDCVMP=NDCOVM+l 
IPARM=N+H 
H2N=IPARM+N 
NPARM=IPARM+2*T 

I FC C IPARM . EQ. 0) . AND . CT . NE . 0) ) NPARM=NPARM+1 

N0PP=NPARM+2 

NP1 =N+1 

I FC NDERV * GE . NDCOVM) GO TO 25 
WRITEC6 , 330 ) NDERV 

330 FORMATC1X, ***** ATTENTION: NDCOVM MUST NOT EXCEED *,I2,* *****) 

STOP 

25 IFCNPARM. LE.NOBS) GO TO 26 
WRITEC 6 , 331 ) NPARM, NOBS 

331 FORMATC1X, ***** ATTENTION: NUMBER OF PARAMETERS SIS, 1 EXCEEDS AM 

*OUNT OF DATA ' , 15 , * ****') 

STOP 

26 I FC INTERP . EQ . 1 ) GO TO 470 

I FC C I SHOW . EQ . 0 ) . OR . C ISHOH . EQ . 3 ) ) GO TO 710 

WRITEC 6, 23) TS, N, ICOV, NDCOVM, NDERV, I PRINT, ITERMX, NOBS, TF, MH, 

*ICOR, INTERP, ISHOW, KNTADJ , LGRMAX, EPS, KO,T, INTV 

23 FORMATC/IX, 'B-SPLINE OUTPUT *//lX, ’PARAMETERS: *//lX, *TS = *,F 

*15.8, • N = 1 , 13, 1 ICOV = * , 13 ,* NDCOVM = 1 , 13, * NDERV = * , 
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*13,’ IPRINT = ’,13,’ ITERMX = ’,13,’ NOBS = ’,I5/1X,’TF = 
*F15 . 8 , ' H = ’,13,’ ICOR = ’,13,’ INTERP = ’,13,’ ISHOW = ’ 

X, 13, * KNTADJ = ’,13,’ LGRMAX = ’,13,’ EPS = ’ , F6 . 4/1X, ’ KO = 

*’,115,’ T = ’,13,’ INTV = ’ , I3//1X, * RAW DATA ’//3X,’OBS', 

*11X, 'X VALUE' , 19X, ' F( X) ' , 13X, ’SIGMA’//) 

DO 69 11=1, NOBS 

69 WRITE( 6 , 678 ) II , XC II) , S( II ) , SIGC II ) 

678 FORMAT ( 1 X , I 5 , 3X , FI 5 . 8 , 3X , F20 . 1 0 , 3X , FI 5 . 8 ) 

IFCT.NE.O) WRITE!6,604) 

604 FORMAT ( //3X, ’NUM’,7X, ’A PRIORI FIT FREQUENCY'//) 

DO 33 11=1, T 

33 WRITE! 6 ,626 ) II,FREQ(II) 

626 FORMAT !1X,I5,14X»F15.8) 

IF! H2N . NE . 0 ) WRITE! 6 ,677 ) 

677 F0RMAT(//3X, ’NUM’,7X, ’ORIGINAL KNOT POSITION’//) 

DO 66 11=1, H2N 

66 WRITE! 6 , 676 ) II,ELAM!II) 

676 FORMAT !1X,I5,14X,F15.8) 

IF! IPARM . EQ . 0 ) GO TO 700 

CALL CAL BSP! ELAM! NP1 ) , NP1 , ELAM, N, H,X, S, SIG,NOBS, V, LDV, LCV, LDC, LCR, 
*COEF, D, NPARM, NOPP, H2N, WTRMS, ISING, NP1 , NSHOW, NPRINT, INTERP , GSIG, 
*RESID,XINTRP, FREQ, T,TS, INTV) 

WRITE! 6 , 400 ) WTRMS 

400 F0RMAT!/1X, ’WEIGHTED RMS OF FIT = ’,F20.10) 

710 IF! IPARM. EQ. 0) GO TO 700 
IF! KNTADJ . EQ . 0) GO TO 700 
DO 10 KITER=1, ITERMX 
DIFMAX=0 .DO 
DO 20 IUV=NP1, IPARM 
IUVEC=IPARM-IUV+NP1 
IF! KSKIP! IUVEC-N ) . EQ . 1 ) GO TO 20 
VALMIN=ELAM! IUVEC-1) 

VALMAX=ELAM! IUVEC+1) 

BPT=ELAM! IUVEC) 

IFfIUVEC.NE.NPl) GO TO 100 
110 VALMIN=VALMIN+EPS 

CALL CALBSP!VALMIN, IUVEC, ELAM, N,H,X,S,SIG, NOBS, V, LDV, LCV, LDC, LCR, 
XCOEF, D, NPARM, NOPP , H2N, FVMIN, ISING, NP1 , NSHOW, NPRINT , INTERP, GSIG, 
XRESID, XINTRP, FREQ, T,TS, INTV) 

IF! ISING . EQ . 1 ) GO TO 110 
100 IF!IUVEC.NE. IPARM) GO TO 120 
130 VALMAX=VALMAX-EPS 

CALL CALBSP! VALMAX, IUVEC, ELAM, N,H,X,S,SIG, NOBS, V, LDV, LCV, LDC, LCR, 
*COEF, D, NPARM, NOPP, H2N , FVMAX, ISING, NP1 , NSHOW, NPRINT, INTERP, GSIG, 
XRESID, XINTRP, FREQ, T , TS, INTV) 

IF! ISING . EQ . 1 ) GO TO 130 
120 DPAST =BPT 

CALL CALBSP! BPT , IUVEC, ELAM, N, H, X, S, SIG, NOBS, V, LDV, LCV , LDC, LCR, 

XCOEF, D, NPARM, NOPP, H2N,FBPT, ISING, NP1, NSHOW, NPRINT, INTERP, GSIG, 

XRESID, XINTRP, FREQ, T ,TS, INTV) 

DOLD=FBPT 
STEP=10 . DOXEPS 
140 VALHI=BPT+STEP 

IFIVALHI.LT. VALMAX) GO TO 150 
CPT =VALMAX 

IF!IUVEC.EQ. IPARM) GO TO 145 

CALL CALBSP!CPT,IUVEC,ELAM,N,H,X,S,SIG,NOBS,V,LDV,LCV,LDC,LCR, 
XCOEF, D, NPARM, NOPP , H2N, FCPT, ISING, NP1 , NSHOW, NPRINT , INTERP , GSIG, 
XRESID, XINTRP, FREQ, T,TS, INTV) 

GO TO 160 
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1«5 FCPT=FVMAX 
GO TO 160 

150 CALL CALBSPC VALHI, IUVEC, ELAM, N,H,X,S,SIG, NOBS, V, LDV, LCV, LDC, LCR, 
XCOEF, D, NPARM, NOPP, H2N, DNEW, ISING, NP1 , NSHOW, NPRINT, INTERP, GSIG, 
*RESID,XINTRP, FREQ, T.TS, INTV) 

IFCDNEW.GT.DOLD) GO TO 170 
DOLD=DNEW 
STEP=STEP+STEP 
GO TO 1 AO 
170 CPT =VALHI 
FCPT=DNEW 
160 DOLD=FBPT 

5TEP=10 . DOXEPS 
180 VALLO=BPT-STEP 

IF( VALLO.GT . VALMIN) GO TO 190 
APT=VALMIN 

IFC IUVEC. EQ.NP1) GO TO 195 

CALL CALBSPC APT, IUVEC, ELAM, N,H,X,S,SIG, NOBS, V, LDV, LCV, LDC, LCR, 
XCOEF, D, NPARM, NOPP ,H2N, FAPT, ISING, NP1 , NSHOW, NPRINT, INTERP, GSIG, 
XRESID,XINTRP, FREQ, T,TS, INTV) 

GO TO 200 
195 FAPT=FVMIN 
GO TO 200 

190 CALL CALBSPC VALLO, IUVEC, ELAM, N, H, X, S, SI G, NOBS, V, LDV, LCV, LDC, LCR, 
XCOEF, D, NPARM, NOPP, H2N, DNEW, ISING, NP1 , NSHOW, NPRINT, INTERP, GSIG, 
XRESI D , XI NTRP , FREQ , T , TS , I NTV ) 

I F ( DNEW . GT . DOL D ) GO TO 210 
DOLD=DNEW 
STEP=STEP+STEP 
GO TO 180 
210 APT=VALLO 
FAPT=DNEW 

200 CALL L AGRANC APT , BPT, CPT , DPT , ELAM, IUVEC, N, H, X, S, SIG, NOBS, V, LDV, LCV, 
XL DC, LCR, COEF, D, NPARM, H2N , EPS, LGRMAX, NOPP, NP1 , FAPT, FBPT, FCPT, FDPT, 
XKITER,ISHOW, GSIG, RESID, XINTRP, FREQ, T,TS, INTV) 
DIFLAM=DABSCDPAST-DPT) 

ELAMC IUVEC) =DPT 

IF( DIFL AM . GT . DIFMAX) DI FMAX=DI FLAM 
20 CONTINUE 

10 IFCDIFMAX.LE.EPS) GO TO 30 

IF( ( ISHOW. EQ . 1 ) . OR. ( ISHOW . EQ . 2) ) WRITEC6,119) ITERMX 
119 F0RMAT(//1X, ’ADJUSTED KNOT POSITIONS ARE BEST FOR MAXIMUM ITERATIO 
XN NUMBER OF ’,12) 

GO TO 55 

30 IFC ( ISHON. EQ . 1 ) . OR. ( ISHOW. EQ .2) ) WRITE(6,555) KITER 
555 FORMATC//1X, 'ADJUSTED KNOT POSITIONS CONVERGED AFTER ',I2,» ITERAT 
XIONS* ) 

55 IFC (ISHOW. EQ . 0) . OR. ( ISHOW . EQ . 3) ) GO TO 700 
WRITEC6 , 122) 

122 FORMAT C//3X, ’NUM' ,7X, 'ADJUSTED KNOT POSITION’//) 

DO 72 11=1, H2N 

72 WRITE(6,644) II,ELAM(II) 

6AA FORMAT C1X,I5,14X,F15.8) 

CALL CALBSPC ELAMCNP1 ), NP1, ELAM, N,H,X,S, SIG, NOBS, V, LDV, LCV, LDC, LCR, 
XCOEF , D, NPARM, NOPP, H2N, WTRMS, ISING, NP1 , NSHOW, NPRINT, INTERP, GSIG, 
XRESID, XINTRP, FREQ, T,TS, INTV) 

WRITEC 6,400) WTRMS 

700 CALL CALBSPC ELAMCNP1), NP1, ELAM, N,H,X,S, SIG, NOBS, V,NDERVP, ICOV, 
XNDCVMP, ICOR, COEF, D, NPARM, NOPP, H2N, FLAST, ISING, NP1 , ISHOW, IPRINT, 
XINTERP, GSIG, RESID, XINTRP, FREQ, T,TS, INTV) 
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DO 40 11=1, H 

40 EKNOTS( II )=ELAM( II+N) 

RETURN 

470 IF( ( ISHOW . EQ . 1 ) . OR . ( I SHOW . EQ . 3) ) WRITE(6,520) XINTRP 

520 FORMAT (/IX, 'XX B-SPLINE INTERPOLATION: X = ’,F15.8,’ XX'/) 

CALL CAL BSP ( EL AM( NP1 ) , NP1 , EL AM, N, H, X, S, SIG, NOBS, V, NDERVP , ICOV , 
XNDCVMP, ICOR,COEF, D, NPARM, NOPP, H2N, FLAST , ISING,NP1 , ISHOW, IPRINT , 
XINTERP,GSIG,RESID, XINTRP, FREQ, T,TS, INTV) 

RETURN 

END 

SUBROUTINE L AGRAN( APT , BPT , CPT , DPT , ELAM, IUVEC, N, H,X, S, SIG, NOBS , V, 
XLDV, LCV, L DC, LCR, COEF, D, NPARM, H2N, EPS, LGRMAX, NOPP, NP1 , FAPT , FBPT , 
XFCPT, FDPT,KITER, ISHOW, GSIG,RESID, XINTRP, FREQ, T,TS, INTV) 

IMPLICIT REALX8CA-H, O-Z) 

DIMENSION X(500) ,S( 500), COEF( 500), ELAMC 500), VC 5,500 ),SIG( 500) 
DIMENSION D( 13000 ) ,GSIG( 5, 500) , RESIDC 500) , FREQC500) 

INTEGER H,H2N,T 
NSHOW=0 
NPRINT=0 
INTERP=0 

DO 1 ITER=1, LGRMAX 

DENOM=( BPT -CPT) XFAPT+ (CPT -APT) XFBPT+ (APT -BPT) XFCPT 

IF( DENOM . LT . 0 . DO ) GO TO 50 

IF(FAPT.LT.FCPT) GO TO 10 

APT=BPT 

FAPT=FBPT 

BPT=( APT+CPT)/2 . DO 
DOLD=BPT 

IF( DABS( CPT-BPT) . GT . EPS) GO TO 2 

DPT = BPT 

RETURN 

2 CALL CALBSP( BPT, IUVEC, ELAM, N,H,X,S, SIG, NOBS, V,LDV, LCV, LDC, LCR, 
XCOEF, D, NPARM, NOPP, H2N, FBPT, ISING, NP1 , NSHOW, NPRINT , INTERP, GSIG, 
XRESID, XINTRP , FREQ , T, TS, INTV) 

GO TO 1 
10 CPT=BPT 

FCPT=FBPT 

BPT=( APT+CPT)/2 . DO 
DOLD=BPT 

IF(DABS(BPT-APT) .GT . EPS) GO TO 3 

DPT = BPT 

RETURN 

3 CALL CAL BSP( BPT, IUVEC, ELAM, N, H,X,S, SIG, NOBS, V,LDV, LCV, LDC, LCR, 
XCOEF, D, NPARM, NOPP, H2N, FBPT, ISING, NP1, NSHOW, NPRINT, INTERP, GSIG, 
XRESID, XINTRP, FREQ, T,TS, INTV) 

GO TO 1 

50 DPT=0.5D0X((BPTXX2-CPTXX2)XFAPT+(CPTXX2-APTXX2)XFBPT+(APTXX2- 
XBPTXX2) XFCPT) /DENOM 
IF(ITER.EQ.l) GO TO 4 
IF(DABS(DOLD-DPT) .LE.EPS) RETURN 

4 DOLD=DPT 

CALL CALBSP( DPT, IUVEC, ELAM, N, H, X, S, SIG, NOBS, V, LDV, LCV, LDC, LCR, 
XCOEF, D, NPARM, NOPP, H2N, FDPT, ISING, NP1, NSHOW, NPRINT, INTERP, GSIG, 
XRESID, XINTRP, FREQ, T,TS, INTV) 

IF( APT . LE. DPT . AND . DPT . LE. BPT) GO TO 5 
IF(BPT . LE. DPT . AND . DPT . LE. CPT) GO TO 6 
IF(DPT.LT .APT) GO TO 7 
IF(DPT.GT.CPT) GO TO 8 

5 IF( FDPT . LE. FBPT) GO TO 9 
APT =DPT 
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FAPT=FDPT 
GO TO 1 
9 CPT=BPT 
FCPT=FBPT 
BPT=DPT 
FBPT=FDPT 
GO TO 1 

6 IFCFDPT. LE. FBPT) GO TO 12 
CPT=DPT 

FCPT=FDPT 
GO TO 1 
12 APT=BPT 

FAPT=FBPT 
BPT = DPT 
FBPT=FDPT 
GO TO 1 

7 DPT=APT 
FDPT=FAPT 
RETURN 

8 DPT =CPT 
FDPT=FCPT 
RETURN 

1 CONTINUE 

I F C ( ISHOW . EQ . 1 ) . OR . C ISHOW . EO . 2 ) ) WRITEC 6,100) LGRMAX, IUVEC, KITER 
100 F0RMATC//1X, 'WARNING: LAGRANGIAN INTERPOLATION DID NOT CONVERGE W 

*ITHIN f ,I2,' STEPS FOR KNOT NUMBER M2,' AT ITERATION f ,I2) 

RETURN 

END 

SUBROUTINE CALBSPC PNT, IUVEC, ELAM, N, H,X, S, SIG, NOBS, V, NDERVP, ICOV, 
XNDCVMP, ICOR, COEF, D, NPARM, NOPP, H2N, WTRMS, ISING, NP1 , ISHOW, IPRINT, 
*INTERP,GSIG, RESID,XINTRP, FREQ,T,TS, INTV) 

IMPLICIT REAL*8CA-H,0-Z) 

DIMENSION FC500),X(500),S(500),COEF(500), RES I DC 500 ), 1ST (500) 
DIMENSION ELAMC500), DIAG(500),CSUM(50Q),FCTC500),GSIG(5,500) 
DIMENSION V(5,500),SIG(5D0) , XARRAYC6, 500, 20), DC 130 00), G( 130 00) 
DIMENSION FREQC500) 

INTEGER H, H2N, T 

INDX(NRQW,NCOL,NDIM)=(NRON*CNDIM+NDIM+5-NRON))/2+NCOL-NDIM-2 

IPARM=H+N 

JPARM=NPARM-IPARM 

EL AMC IUVEC) = PNT 

IF( INTERP . EQ . 1 ) GO TO 360 

MAXD= ( NPARMXC NPARM+1 ) )/2+2*NPARM 

DO 9 11=1, MAXD 

9 DC II ) = 0 . DO 

DO 10 11=1, NPARM 
F( II ) =0 . DO 

10 COEFC II )=0 . DO 

DO 100 N0B=1 , NOBS 
WT=1 . DO 

IFCSIGCNOB) .NE.Q.DO) WT=1 . DO/SIGCNOB) 

IF(N.NE.O) CALL CALMTXCXCNOB) , H2N, N, IPARM, ELAM, I, NDERVP, XARRAY, 
*NOB) 

1ST ( NOB ) =1 
DO 110 IL0P=1 , N 

110 FCI+ILOP-l) =XARRAYC 1 , NOB, N-ILOP+1 )XWT 

IFCT.NE.O) CALL CALTRGCT,TS,N, NOB, X(NOB) , FREQ, XARRAY, NDERVP) 

I FC (IPARM . EQ . 0 ) . AND . (T . NE . 0 ) ) XARRAY ( 1 , NOB, NPARM) =1 . DO 
DO 123 ILOP=l , JPARM 

123 F( I PARM+ 1 L OP ) =XARRAY C 1 , NOB , N+ 1 L OP ) *WT 
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FCNPARM+1)=SCN0B)XWT 
CALL CALNORCD,F, NPARM) 

DO 120 ILOP=l , N 

120 FC I+I LOP-1 ) =0 . DO 

DO 121 IL0P=1 , JPARM 

121 F( IPARM+ILOP ) =0 . DO 

100 FCNPARM+1 ) =0 . DO 
DO 176 1=1, NPARM 
CSUM( I )=0 . DO 

DO 176 J=l, NPARM 
NTOT = I+J 
NROW=MINOCI, J) 

NCOL =NTOT-NROW 
K=INDX( NROW, NCOL , NPARM) 

176 CSUM( I ) =CSUM( I )+DC K) 

IFCN.EQ.O) IUVEC=2 

CALL CALINVCNPARM,NOPP, D, DIAG, NP1 , IUVEC, ISING) 

DO 880 1=1, NPARM 
DIAGC I ) =0 . DO 
DO 885 J=l, NPARM 
NTOT=I+J 
NROW=MINO(I, J) 

NCOL =NTOT -NROW 
K=INDX(NROW, NCOL , NPARM) 

KRHS=INDX( J , NPARM+1 , NPARM) 

COEFCI)=COEFCI)+DCKRHS)XDCK) 

885 DIAGC I)=DIAGC I )+D(K)*CSUM( J ) 

IFC ( I SHOW . NE . 1 ) . AND . ( ISHOW . NE . 2) ) GO TO 880 
IFCCI.EQ.l) . AND. CIPARM.NE. 0) ) WRITEC6,131) 

131 FORMATC//1X, 'B-SPLINE COEFFICIENTS *//5X, *1 * , 16X, 'COEFC I ) ' , 16 

XX, 'DIAGCI) '//) 

IFC I . EQ . IPARM+1 ) WRITEC6 , 101 ) 

101 FORMATC//1X, 'FOURIER COEFFICIENTS '//5X, ’I' ,16X, 'COEFCI) > , 16X 

X, 'DIAGCI) '//) 

IFC I . LE . IPARM) WRITEC6,990) I, COEFC I) , DIAGC I) 

IFC I . GT . IPARM) WRITEC6,990) I-IPARM, COEFC I ), DIAGCI) 

880 CONTINUE 

990 FORMAT C1X,I5,2C3X,F20.10)) 

DO 890 NOB=l , NOBS 

CALL CALCOFCFCT,COEF,XARRAY,N,NDERVP,ISTC NOB), NOB, NPARM, IPARM) 

DO 890 ID=1 , NDERVP 
890 VC ID, NOB ) = FCT C ID) 

CALL CA L VAR C NOBS, 1ST , XARRAY , D, N, NPARM, G, ICOV , NDCVMP , ICOR, GSIG, 
XISHOW, INTERP, JPARM) 

IFC C ISHOW . EQ . 1 ) . OR . C ISHOW. EQ . 2) ) WRITEC6,951) 

951 FORMATC//1X, 'B-SPLINE FITS *//3X, 'OBS' ,8X, 'X VALUE' , 15X, ’ SOCX 

x) ' , 9X, 'RESIDUAL CX)',15X, 'SI CX) ' , 15X, ’S2CX) ' , 15X, 'S3CX) . . . '//) 
RMEAN=0 . DO 
RSS=0 . DO 

DO 819 NOB=l , NOBS 

RESIDC NOB)=SCNOB)-VCl, NOB) 

IFC NOB . EQ . 1 ) RESMIN=RESIDC NOB) 

IFC NOB . EQ . 1 ) RESMAX=RESIDCNOB) 

IFCRESIDCNOB) . LT . RESMIN) RESMIN=RESIDC NOB) 

IFC RESIDC NOB) .GT . RESMAX) RESMAX=RESIDC NOB) 

IFC C ISHOW. EQ.l) .OR. C ISHOW. EO. 2)) WRITEC6,995) NOB,XC NOB) , VC 1 , NOB ) , 
XRESIDC NOB) ,C VC ID, NOB), ID=2, NDERVP) 

995 FORMAT C1X,I5,F15.8,5F20.10) 

RMEAN=RMEAN+RESIDCNOB) 

WT = 1 . DO 
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IF(SIGCNOB) .NE.O.DO) WT=1 . DO/SIGC NOB) 

819 R3S=RSS+(RESID(N0B)XWT)XX2 

RESINC=(RESMAX-RESMIN) /REAL (INTV ) 

RMEAN=RMEAN/NOBS 
WTRMS=DSQRT (RSS/NOBS) 

IF( C I SHOW . EQ . 1 ) . OR . ( I SHOW . EQ . 2) ) CALL CALSTAC WTRMS, RMEAN, RESID, 
XNOBS, RESMAX, RESMIN, RSTDV) 

IF( IPRINT . GT . 0) CALL BSPLOTC IPRINT,X, S, V,GSIG, NOBS, NDCVMP, NDERVP, 
XELAM, H,N, RESID, INTV, RESMIN, RESINC, RMEAN, RSTDV) 

RETURN 
360 NOB=l 

IFCN.NE.O) CALL CALMTXCXINTRP, H2N, N, IPARM, ELAM, I ,NDERVP, XARRAY, 
XNOB) 

IFCT.NE.O) CALL CALTRGCT,TS, N, NOB, XINTRP, FREQ, XARRAY, NDERVP) 

CALL CALCOFC FCT , COEF, XARRAY, N, NDERVP , I , NOB, NPARM, IPARM) 

IST(NOB) =1 

CALL CALVARCNOB, 1ST, XARRAY, D,N, NPARM, G, ICDV, NDCVMP, ICOR,GSIG, 
x I SHOW, INTERP, JPARM) 

DO 893 ID=1, NDERVP 
VC ID, 1 ) = FCT (ID) 

I F( ( I SHOW . EQ . 0) .OR. ( ISHON . EQ . 2) ) GO TO 893 
GVAR=GSIGCID,l)x*2 

IFCID.LE. NDCVMP) WRITEC6,991) ID-1 , VC ID, 1 ) , GSIGCID, 1 ) , GVAR 

991 FORMAT (IX, f S f ,11, 1 (X) VALUE = f , F20 . 10, 3X, 1 SIGMA = • , F20 . 10, 3X, 1 VA 
XRIANCE = f , F20 . 10 ) 

I F( ID . GT . NDCVMP ) WRITEC6,992) ID-1, V(ID,1) 

992 FORMATC1X, ’S’ ,11, '(X) VALUE = f ,F20.10) 

893 CONTINUE 

RETURN 

END 

SUBROUTINE CALMTXC X, H2N, N, NPARM, ELAM, I , NDERVP, ARRAY, NOB) 

IMPLICIT REALX8C A-H, O-Z) 

DIMENSION EL AMC 500 ) , ARRAYC6 ,500,20), ARNNJJC 6 ) 

INTEGER H2N 

DATA ARNNJJ/6X0.DQ/ 

INDXXC NROW, NCOL , NDIM) = ( NROWXC NDIM+NDIM+l-NROH) )/2+NC0L-NDIM 
NPARM1 =NPARM+1 

CALL BSERCHCN, NPARM1, ILAM, X, ELAM, I ) 

DO 797 ID=1, NDERVP 
797 ARRAYC ID, NOB , 1 ) =0 . DO 

DELT=ELAM( ILAM)-ELAM( ILAM-1) 

IFCDELT.NE.O .DO) ARRAYC 1 , NOB, 1 ) =1 . DO/DELT 

IFCN.EQ.l) GO TO 200 

KSHIFT = -l 

IILAM=ILAM 

DO 100 J J-l , N 

KSHIFT =KSHIFT+1 

DO 150 NN-J J , N 

IF( J J . EQ . 1 . AND. NN . EQ . 1 ) GO TO 150 
DEL=ELAM( IILAM)-ELAM( IILAM-NN) 

IFCNN.EQ.N) DEL=1 . DO 
INDJM1 = INDXX( J J-K5HIFT , NN-KSHIFT, N) 

I NDJ EQ r INDXX( JJ -KSHIFT, NN-l-KSHIFT , N) 

DO 210 ID=1, NDERVP 
ARJM1=0 . DO 
ARJEQ=0 . DO 

I FC J J . NE . 1 ) ARJM1 =ARRAYC ID, NOB, INDJM1 ) 

IFCNN.NE. JJ) ARJEQ= ARRAY (ID, NOB, INDJEQ) 

ARI JM1 =0 . DO 
ARI J EQ = 0 . DO 


A-82 



IF(ID.EQ.l) GO TO 35 

IF( J J . NE . 1) ARIJMl =ARRAYC ID-1 , NOB, INDJM1 ) 

IFCNN.NE.JJ) ARI JEQ=ARRAY( ID-1 , NOB, INDJEQ) 

35 ARNNJ J( ID) =( X-ELAMC IILAM-NN) )XARJMl+( ELAMC IILAM)-X)XARJEQ+( DFLOATC 
*ID-1 )*( ARI JM1-ARI JEQ) ) 

210 IFC DABSC ARNNJ J ( ID)).LE.l.D-25) ARNNJ J ( ID) =0 . DO 
DO 177 ID=1,NDERVP 

IFC J J . EQ . 1 ) ARRAY C ID, NOB, INDJEO+1 ) =ARNNJ J ( ID)/DEL 
177 IF(JJ.NE.l) ARRAYS ID, NOB, INDJM1 ) =ARNNJ J ( IDJ/DEL 
150 CONTINUE 
100 IILAM=IILAM+1 
200 RETURN 
END 

SUBROUTINE CALCOF( FCT,COEF, ARRAY , N, NDERVP, I , NOB, NPARM, IPARM) 
IMPLICIT REAL*8CA-H,0-Z) 

DIMENSION FCTC 1 ) , COEFC 1 ) , ARRAYC6 , 500,20) 

DO 200 ID=1, NDERVP 
200 FCT ( ID) =0 . DO 
DO 300 K=1 , N 
DO 300 ID=1, NDERVP 

300 FCT ( I D ) = FCT (ID) +COEF (I+K-l) XARRAY ( I D , NOB , N-K+l ) 

JPARM=NPARM-IPARM 
IFC JPARM.EQ.O) RETURN 
DO 400 L=l, JPARM 
DO 400 ID=1, NDERVP 

400 FCT ( I D ) = FCT ( I D ) +COEFC I PARM+ L ) XARRAY ( I D , NOB , N+L ) 

RETURN 

END 

SUBROUTINE CALNOR( D, F , NPARM) 

IMPLICIT REAL*8(A-H, O-Z) 

DIMENSION D(1),F(1) 

NOP=NPARM+l 

K=1 

DO 27 1=1, NPARM 
FWT=F( I ) 

NLENG=NOP-I+l 
DO 28 J=1 , NLENG 

28 D(K+J-1)=D(K+J-1)+FWTXF(I+J-1) 

27 K=K+NLENG+1 
RETURN 
END 

SUBROUTINE CALINV( LL , MM, A, R, NP1 , IUVEC, ISING) 

DOUBLE PRECISION AC 1 ) , DPIV, DSUM, A2, R( 1 ) 

IDIGL=0 

LTROW=l 

IFCLL.LT. l)GO TO 900 

LL1=LL-1 

K1 = 0 

LM=MM-LL 

IND=-LM 

DO 90 K=1 , LL 

IND=IND+LM 

KPIV=IND+1 

LEND=K-1 

TOL=A( KPIV) 

DO 80 I =K, LL 
IND=IND+1 
DSUM=0 . DO 
IF(LEND)30,30,10 
10 LANF=K 
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LIND=I-K 
DO 20 L =1 , LEND 

DSUM=DSUM+A( LANF)XA( LANF+LIND) 

20 LANF=LANF+MM-L 
30 DSUM=ACIND)-DSUM 
IFCI . NE.K)60 TO 70 
IF( DSUMJ900 , 900,40 
AO IDIG=AL0G10(T0L/SNGLCDSUM))-.5 
IF(IDIG. LE. IDIGL )G0 TO 60 
IDIGL=IDIG 
LTROW=I 

60 DPIV=DSQRT ( DSUM) 

A1=C 1 . DO/DPIV) 

A2=C1.D0-DBLE(A1)XDPIV)/DPIV 

A(IND)=DPIV 

R(K)=DPIV 

GO TO 80 

70 ACIND)=A2*DSUM+DBLE(A1)*DSUM 
80 CONTINUE 
90 CONTINUE 

DO 152 K = 1 , LL 
DPIV=A( KPI V) 

Al=(l .DO/DPIV) 

A2=(1.D0-DBLE(A1)XDPIV)/DPIV 
A(KPIV)=A2+DBLE(A1 ) 

R( LL-K+1 )=A( KPIV) 

LEND=K-1 

IFtLEND)130, 130,110 
110 DO 120 L=1 , LEND 
IND=KPIV+L 

120 A(IND)=-(A2XA(IND)+DBLE(A1)XACIND)) 
130 IF( K. EQ . LL )G0 TO 152 
IND=KPIV 

KPIV=KPI V-LM-l-K 
LANF=IND 
DO 151 I=K,LL1 
LANF=LANF-LM-I 
DSUM=A( LANF) 

A(LANF)=A2XDSUM+DBLE(A1)XDSUM 
IF(LEND)151,151,140 
140 DO 150 L=1,IEND 
LIND=LANF+L 

150 A(LIND)=A(LIND)+DSUMXA(IND+L) 

151 CONTINUE 

152 CONTINUE 

DO 180 K = 1 , L L 

LIND=KPIV-1 

LANF=KPIV 

DO 170 I=K, LL 

DSUM=0 . DO 

DO 160 L=KPIV, IND 

LIND=LIND+1 

160 DSUM=DSUM+A( L )XA( LIND) 

A(KPIV)=DSUM 
LIND=LIND+LM 
170 KPIV=KPIV+1 
KPIV=KPIV+LM 
180 IND=IND+MM-K 
ISING=0 
RETURN 


900 IFC CIUVEC.EQ.NP1) . OR . C IUVEC . EQ . LL ) ) GO TO 700 
IDIGL=-1 
LTROM=I 

WRITE( 6,920) LTROW 

920 FORMAT ( 5X , * XX*X INVERSION FAILED AT RON ’,13,' ****') 

STOP 13 
700 ISING=1 
RETURN 
END 

SUBROUTINE CAL VAR( INUM, 1ST, ARRAY, D, N, NPARM,G, ICOV, NDCVMP, ICOR, 
KGSIG, ISHOW, INTERP, JPARM) 

IMPLICIT REAL*8(A-H,0-Z) 

DIMENSION G( 13000), IST(l) , ARRAY(6 , 500 , 20) , D( 1 ) ,GSIGC5, 500 ) 

INDX( NROW, NCOL , NDIM)=( NR0WXCNDIM+NDIM+5-NR0W) )/2+NC0L-NDIM-2 
INDXXC NROW, NCOL , NDIM) =( NROW*( NDIM+NDIM+1 -NROW) )/2+NC0L-NDIM 
MPARM=N+ JPARM 
DO 10 L 0 = 1 , NDCVMP 

I F(( INTERP. EQ.O) . AND . C ISHOW . NE . 0 ) .AND. CISH0W.NE.3) ) WRITE<6,327) 
*L0-1 

327 FORMAT (//IX, * S' , II , ' (X) COVARIANCE MATRIX CORRELATION MAT 

KRIX '//AX, ' I ' , 3X, ' J ' , 10X, ' COVC I, J)',10X,»SIGMAS',10X, 'CORCI.J 

X) '//) 

KOUNT=0 

DO 11 Ll=l , INUM 

IFtNPARM.NE. JPARM) ISTLM1=IST(L1)-1 
LIM=INUM 

IF(ICOV.EQ.O) LIM=L1 
DO 11 L2=L1 , LIM 

IF(NPARM.NE. JPARM) ISTLM2=IST( L2)-l 
KOUNT =KOUNT+l 
G( KOUNT)=0 . DO 
DO 11 JJ=1 ,MPARM 
IF(JJ.LE.N) JJP0S=ISTLM2+JJ 
IF(JJ.GT.N) J JPOS=NPARM-MPARM+J J 
IF(JJ.LE.N) ARR2= ARRAY ( LO, L2, N-J J+l ) 

IF(JJ.GT.N) ARR2=ARRAY( LO, L2, J J ) 

SUM=0 . DO 

DO 12 11=1 , MPARM 
IFCII.LE.N) IIP0S=ISTLM1+II 
IF(II.GT.N) IIPOS=NPARM-MPARM+II 
IF(II . LE.N) ARR1=ARRAY( LO , LI , N-II+1 ) 

IF(II.GT.N) ARR1=ARRAY( LO , LI , II ) 

NTOT=IIPOS+J JPOS 
NROW=MINO( IIPOS, J JPOS) 

NCOL =NTOT-NROW 
K=INDX( NROW, NCOL , NPARM) 

12 SUM=SUM+ARR1*D(K) 

11 G( KOUNT ) =G( KOUNT )+ARR2*SUM 

KOWNT=0 

DO 13 IRS=1 , INUM 
LIM=INUM 

IF(ICOV.EQ.O) LIM=IRS 
KI= INDXXC IRS, IRS, INUM) 

IFCICOV.EQ.O) KI=IRS 
GIPIV=G(KI) 

DO 13 ICS=IRS, LIM 
KJ=INDXX( ICS, ICS, INUM) 

IF(ICOV. EQ. 0) KJ=IRS 
GJPIV=G( KJ ) 

KIJ=INDXX( IRS, ICS, INUM) 
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IFCICOV.EQ.O) KIJ=IRS 
GI J=GCKI J) 

IFCIRS.EQ.ICS) KOWNT =KOWNT+l 
IFCIRS.EQ.ICS) GSIGC LO , KOWNT) =DSQRT CGI J ) 

IF( INTERP . EQ . 1 ) RETURN 

IFCICOR.EQ.l) GCOR=GI J/DSQRT CGIPIVXGJPIV) 

IF( (ISHOW.EQ.O) .OR. C ISHOW. EQ . 3) ) GO TO 13 
IFCICOR.EQ.O) GO TO 27 

IFCIRS.EQ.ICS) MRITEC 6 , 224) IRS, ICS, GI J , GSIGC 10, KOWNT) ,GCOR 

224 FORMAT C1X,2I4,3X,F15.8,5X,F11.8,3X,F15.8) 

IFCIRS.NE.ICS) WRITEC6,225) IRS, ICS,GIJ,GCOR 

225 FORMAT C1X,2I4,3X,F15.8,19X,F15.8) 

GO TO 13 

27 IFCIRS.EQ.ICS) WRITEC6,226) IRS, ICS, GIJ,GSIGCLO, KOWNT) 

226 FORMAT C1X,2I4,3X,F15.8,5X,F11.8) 

IFCIRS.NE.ICS) MRITEC6 , 227 ) IRS,ICS,GIJ 

227 FORMAT C1X,2I4,3X,F15.8) 

13 CONTINUE 

10 CONTINUE 
RETURN 
END 

SUBROUTINE BSERCHCN, NPARM1 , ILAM, X, ELAM, I) 

IMPLICIT REALX8 CA-H,0-Z) 

DIMENSION ELAMC1) 

IBEG=N 

IEND=NPARM1 

30 MID=CIBEG+IEND)/2 

IFC IEND-IBEG. LE. 1 ) GO TO <»0 
IFCX.GE. ELAMCMID) ) IBEG-MID 
IFCX. LT . ELAMCMID) ) IEND=MID 
GO TO 30 
40 ILAM=MID+1 
I=ILAM-N 
RETURN 
END 

SUBROUTINE BSPLOTC IFLAG, X, S, V, GSIG, NOBS, NDCVMP,NDERVP, ELAM, H, N, 
KRESID, INTV, RESMIN, RESINC, RMEAN, RSTDV) 

IMPLICIT REALX4C A-H, O-Z) 

CHARACTERX1 SYMBOL C 5) 

LOGICALX1 IXFMTC7 ) , IYFMTC7) , DVNUM 

REAL *8 XC500),SC500),VC5,500),GSIGC5,500), ELAMC500) ,RESIDC500 ) 
REALX8 RESMIN, RESINC, RMEAN, RSTDV 

DIMENSION XSC500),SSC500),VSC500),GSIGSC500), ENOTXCIOO) , ENOTYC 100) 
DIMENSION RESIDSC500),EKC5,100),KKC5) 

INTEGER H 
EXTERNAL GAUSS 

DATA SYMBOL / , S* , 'D* , *T* , *Q' , *V*/ 

IFC IFLAG. EQ . 1 ) CALL PLOTSTC 00001 , 1 ) 

IFCIFLAG.EQ.2) CALL PLOTSTC 02000, 4) 

IFCIFLAG.EQ.3) CALL PLOTSTC 02001 , 4) 

IFCIFLAG.EQ.l) PH0RX=66 . 0 
IFCIFLAG.EQ.l) PHORY=63.0 
IFCIFLAG.GT.l) PH0RX=4.5 
IFC IFLAG. GT . 1 ) PHORY=4.8 
DO 5 11=1, NOBS 
XSCII)=XCII) 

5 SSCII)=SCII) 

CALL GRDNUMCXS, NOBS, XMIN,XMAX, LINT, IXFMT) 

CAL L NOTPOSC I FL AG , N , H , XMAX , XMIN, ELAM, L TYPER , KK, EK) 

DO 10 11=1 , NDERVP 


A-86 



20 


DO 20 J J=1 , NOBS 
VSCJJ)=VCII, JJ) 

IFCIFLAG.EQ.l) CALL SETGRDC 11 . 0 , 1 0 . 0, 123 . 0,60 . 0 , 1 ) 

IF(IFLAG.GT.l) CALL SETGRDC 1.0, 1.0, 9.0, A. 0,4) 

IFCII.EQ.l) GO TO 25 

CALL GRDNUMC VS, NOBS, PMIN,PMAX, MINT, IYFMT) 

GO TO 26 

25 CALL MAXMINCSS, NOBS, YMIN1 , YMAX1 ) 

CALL MAXMINCVS, NOBS, YMIN2,YMAX2) 

YMIN=YMIN1 

IFCYMIN2 . LT . YMIN1) YMIN=YMIN2 
YMAX=YMAX1 

I F( YMAX2 . GT . YMAX1 ) YMAX=YMAX2 

CALL PTYNUMC YMI N , YMAX , PMIN, PMAX , MI NT ) 

CALL FORMAT C PMIN, PMAX, IYFMT) 

26 CALL OGRIDCXMIN, XMAX, LINT, IXFMT, 1, PMIN, PMAX, MINT, IYFMT, 2,0) 
IFCII.EQ.l) CALL PLOT(XS,SS,NOBS, 'X' ) 

CALL PLOTCXS , VS , NOBS, * ») 

DO 59 JL=1 , LTYPER 
NKNT = KKC JL ) 

DO 44 IK=1 , NKNT 
ENOTXCIK)=EKCJL,IK) 

44 ENOTYCIK)=PMIN 

59 IFCKKCJL) .GT.O) CALL PL OT ( ENOTX, ENOTY, NKNT , SYMBOL ( JL ) ) 

IIM1=II-1 

CALL EDITCIIMl, 'll)*, DVNUM, NNUM, IBL ) 

CALL HORLINC 'B-SPLINE FIT: DERIVATIVE = * ,27,PHORX,PHORY, 0, 0) 

CALL HORL INC DVNUM, 1 , PHORX, PHORY ,28,0) 

10 CALL FRMADV 

DO 30 11=1 , NDCVMP 
DO 40 J J=1 , NOBS 
40 GSIGSC J J )=GSIG( II , J J ) 

IFCIFLAG.EQ.l) CALL SETGRDC 11 . 0 , 1 0 . 0 , 123 . 0,60 . 0 , 1) 

IFCIFLAG.GT. 1) CALL SETGRDC 1 . 0 , 1 . 0 , 9 . 0 , 4 . 0, 4) 

CALL GRDNUMC GS IGS , NOBS , YMI N3 , YMAX3 , KINT , IYFMT) 

CALL OGRIDCXMIN, XMAX , L I NT , I XFMT , 1 , YMI N3 , YMAX3 , KINT , IYFMT ,2,0) 

CALL PLOTCXS, GSIGS, NOBS, ' ') 

DO 75 JL=1, LTYPER 
NKNT=KKC JL) 

DO 74 IK=1 , NKNT 
ENOTXC IK)=EKCJL,IK) 

74 ENOTY CIK)=YMIN3 

75 IFCKKCJL) .GT.O) CALL PL OTC ENOTX, ENOTY, NKNT, SYMBOL CJL ) ) 

IIM1=II-1 

CALL EDITCIIMl, ' II )', DVNUM, NNUM, IBL ) 

CALL HORLINC 'SIGMA PER OBSERVATION: DERIVATIVE = ', 36 , PHORX, PHORY, 
*0,0) 

CALL HORLINC DVNUM, 1 , PHORX, PHORY, 37 ,0) 

30 CALL FRMADV 

DO 50 J J=1 , NOBS 
50 RESIDSC JJ)=RESIDC JJ) 

IFCIFLAG.EQ.l) CALL SETGRDC 11 . 0 , 10 . 0 , 123 . 0,60 . 0 , 1 ) 

IFCIFLAG.GT. 1) CALL SETGRDC 1 . 0, 1 . 0 , 9 . 0 , 4 . 0 , 4) 

CALL GRDNUMC RESIDS, NOBS, YMI N4,YMAX4, LINT, IYFMT) 

CALL OGRIDCXMIN, XMAX, LINT, IXFMT, 1 , YMIN4, YMAX4, LINT, IYFMT, 2,0) 

CALL PLOTCXS, RESIDS, NOBS, ' ') 

DO 17 JL=1, LTYPER 
NKNT=KKC JL ) 

DO 84 IK=1 , NKNT 
ENOTX CIK)=EKCJL,IK) 
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84 EN0TYCIK)=YMIN4 

17 IFCKK(JL) .GT.O) CALL PLOTC ENOTX, ENOTY, NKNT, SYMBOL C JL ) ) 

CALL HORLINC 'RESIDUAL PER OBSERVATION 24 , PHORX,PHORY, 0, 0 ) 

CALL FRMADV 
INTVP1 =INTV+1 
ELM=RESMIN 
DO 60 11=1 , INTVP1 
XSC II ) =ELM 
SSCII)=0.0 
60 ELM=ELM+RESINC 
RMAX=0 . DO 
DO 70 11=1, NOBS 
DO 70 J J=1 , INTV 

IF( ( RESIDS( II ) . GE. XS( J J ) ) . AND . ( RESIDS( II ) . LE . XSC J J + l ) ) ) SSCJJ+1)= 
*SSCJJ+1)+1.0 

70 IFCSSC JJ+1) .GT.RMAX) RMAX=SSC J J+l ) 

DO 80 11=1, INTV 

ENOTXC II )=(XS( II )+XS(II+l ) )/2 . 0 

ENOTYC II ) =GAUSS( RMEAN , RSTDV , XSC I I ) , XSC II+l ) , NOBS) 

80 IFCENOTYCII) .GT.RMAX) RMAX=ENOTYC II ) 

MRX=NINT C RMAX) 

IFCIFLAG.EQ.l) CALL SETGRDC 11 . 0 , 10 . 0, 123 . 0 , 60 . 0, 1 ) 

IFCIFLAG.GT.l) CALL SETGRDC 1 . 0, 1 . 0 , 9 . 0, 4 . 0 , 4) 

CALL 0GRIDCXSC1),XSCINTVP1),INTV, *F6 .1 • , 4, 0 . 0,RMAX,MRX, *14 »,2,0) 
CALL VERHSTCXS,SS, INTVP1) 

CALL PLOTCENOTX, ENOTY, INTV, •*’) 

CALL HORLINC 'RESIDUAL DISTRIBUTION C NORMAL =*) ' ,32, PHORX,PHORY, 0 , 0 ) 

CALL ENDPLT 

RETURN 

END 

SUBROUTINE NOTPOSC IFLAG, N, NH, XMAX, XMIN, ELAM, L TYPER, KK, EIC) 

REALX8 ELAMC500) 

DIMENSION EKC5, 100 ) , KKC5) 

DO 10 11=1,5 
10 KKC II ) =0 
LTYPER=1 

IFC IFLAG . EQ . 1 ) TINC=C XMAX-XMIN)/112 . 0 
IFCIFLAG.GT . 1 ) TINC=CXMAX-XMIN)/80 . 0 
11=0 

20 11=11+1 

IFC II . GT . NH) GO TO 50 
SUMK=REAL C ELAMC II+N) ) 

JJ=0 

30 JJ=JJ+1 

IFCII+JJ.GT.NH) GO TO 40 

IFC ABSC REAL C ELAMC II+N) -ELAMC II +N+JJ ) ) ) .GT . TINC) GO TO 40 
SUMK=SUMK+REAL C ELAMC II+N+JJ ) ) 

GO TO 30 

40 KKCJJ)=KKCJJ)+1 

IFCLTYPER.LT. JJ) LTYPER=JJ 
EKCJJ,KKCJJ))=SUMK/REALCJJ) 

II=II+JJ-1 
GO TO 20 
50 RETURN 
END 

SUBROUTINE CALTRGCNTRIG, TS,N, NOB, XOB, -FREQ, XARRAY, NDERVP) 

IMPLICIT REAL *8 CA-H,0-Z) 

DIMENSION FREQC 500 ) , XARRAYC6 , 500,20) 

DATA TWOPI /6 .283185307179579/ 

OBS=XOB-TS 
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IPARTL =N 

DO 10 IFR0 = 1 , NTRIG 
OMEGA=TWOPIxFREQC IFRQ) 

THETA =OMEGAXOBS 
DO 20 1=1, NDERVP 
IFCMODCI,2).EQ.O) GO TO 30 

XARRAYC I , NOB, IPARTL+1 )=OMEGA**C 1-1 )XCOSCTHETA) 

XARRAYC I , NOB, IPARTL+2)=0MEGA**< 1-1 )XSINCTHETA) 

GO TO AO 

30 XARRAYC I , NOB, IPARTL+1 ) =OMEGA**( 1-1 )XSINCTHETA) 

XARRAYC I , NOB, IPARTL+2)=0MEGA**C 1-1 )XCOSCTHETA) 

AO IREM=MODC I , A ) 

GO TO C2G,50,60), I REM 

XARRAYC I, NOB, IPARTL+2) =-XARRAYC I , NOB, IPARTL+2) 

GO TO 20 

50 XARRAYC I , NOB, IPARTL+1 ) =-XARRAYC I , NOB, IPARTL+1 ) 

GO TO 20 

60 XARRAYC I , NOB, IPARTL+1 ) =-XARRAYC I , NOB, IPARTL+1) 

XARRAYC I , NOB, IPARTL+2) =-XARRAYC I , NOB, IPARTL+2) 

20 CONTINUE 
10 IPARTL = IPARTL+2 
RETURN 
END 

SUBROUTINE CAL STA C WTRMS , RMEAN, RESI D, NOBS , RESMAX, RESMIN , RSTDV ) 
IMPLICIT REALX8 CA-H,0-Z) 

DIMENSION RESIDC500 ) 

RSKEW=0 .DO 
RKURT=0 .DO 
DO 10 MEXP=2, A 
RMOM=0 . DO 
DO 20 11=1, NOBS 

20 RMOM=RMOM+C RESIDC II ) -RMEAN )XXMEXP 
IFCMEXP.NE.2) GO TO 30 
RSTDV=SQRT C RMOM/C NOBS-1 ) ) 

IFC RSTDV. EQ.O. DO) GO TO 50 
30 IFCMEXP.NE.3) GO TO AO 

RSKEW=RM0M/CRSTDV**3*N0BS) 

AO I FCMEXP . NE . A) GO TO 10 

RKURT = RMOM/ C RSTDVXXAXNOBS ) 

10 CONTINUE 

50 WRITEC 6 ,100) RESMAX, WTRMS, RSKEW, RMEAN, RSTDV, RKURT, RESMIN 

100 FORMATC//1X, 'RESIDUAL STATISTICS '//IX, 'MAXIMUM = *,F20.10,10 

XX, 'WEIGHTED RMS = ', F20 . 1 0 , 10X, 'SKEWNESS = ', F20 . 10/1X, 'AVERAGE = 
X', F20. 10, 10X, 'STANDARD DEV = • , F20 . 10, 10X, 'KURTOSIS = *,F20.10/1X, 
X'MINIMUM = ' , F20 . 10 ) 

RETURN 

END 

FUNCTION GAUSSC RMEAN, RSTDV, XI, X2, NOBS) 

IMPLICIT REALXA CA-H,0-Z) 

REALX8 RMEAN, RSTDV 

X3= CXI -RMEAN) /RSTDV/ SORT C2 . 0 ) 

XA = CX2-RMEAN)/RSTDV/SQRTC 2 . 0 ) 
GAUSS=REALCNOBS)X0.5XCERFCXA)-ERFCX3)) 

RETURN 

END 
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PROGRAM BINSIFT s 


//XRJRRSFT JOB (F8002.X22, 15) , ’BINSIFT’ .TIME* (1,0) , CLASS=0, 00010005 

II MSGCLASS=X 00020000 

II* JCL = XRJRR. DMSP. PROGRAMS (BINSIFT) 00030005 

II STEP1 EXEC FORTRAN, FVPXREF=XREF 00040000 

II SYSIN DD * 00050000 

00060000 

— ■ ■■TM r»rn r cccg«icgnQOO7OQO0 

THIS PROGRAM TAKES DMSP DATA, SORTED INTO EQUAL AREA BINS, C00080005 

AND WEEDS THE NUMBER OF POINTS IN THAT BIN DOWN TO A SPECIFIED C00090000 
NUMBER OF POINTS. A PREVIOUS DELETION OF POINTS WAS MADE ON AN C00100000 
ORBIT -BY-ORBIT BASIS BY T.J. SABAKA’S DMSP PROCESSING PROGRAM. C00110005 

DST VALUES HAVE BEEN ADDED TO THE DATA BY ’DSTADD’, INTO SLOT #17. C00120005 
BIN NUMBERS ARE IN SLOT #16, AND THE ’INOTE’ FLAG IN SLOT #18. C00121005 

FOR THIS PROGRAM, AN INOTE=0 MEANS GOOD DATA, AND INOTE .NZ. 0 C00122005 

MEANS BAD DATA. C00123005 

C00130000 

THIS PROGRAM CONTINUES THE REJECTION PROCESS. IT FIRST REJECTS C00140000 

POINTS ACCORDING TO DST (RANGE -20 TO +5) AND THEN RANDOMLY REJECTS C00150000 

POINTS IN A BIN UNTIL THE GOAL IS MET. C00160000 

C00170000 

THE GOAL IS 9 POINTS PER BIN FOR DIPOLE LATITUDE .GT. 30 DEGREES, C 00180005 
AND 3 POINTS PER BIN FOR DIPLAT .LT. 30 DEGREES, FOR DMSP DATA ONLYC00190005 

C00200000 

C00220000 


THIS PROGRAM TAKES DMSP DATA, SORTED INTO EQUAL AREA BINS, 

AND WEEDS THE NUMBER OF POINTS IN THAT BIN DOWN TO A SPECIFIED 
NUMBER OF POINTS. A PREVIOUS DELETION OF POINTS WAS MADE ON AN 
ORBIT -BY-ORBIT BASIS BY T.J. SABAKA’S DMSP PROCESSING PROGRAM. 

DST VALUES HAVE BEEN ADDED TO THE DATA BY ’DSTADD’, INTO SLOT #17 
BIN NUMBERS ARE IN SLOT #16, AND THE ’INOTE’ FLAG IN SLOT #18. 

FOR THIS PROGRAM, AN INOTE=0 MEANS GOOD DATA, AND INOTE .NZ. 0 
MEANS BAD DATA. 


C ======= 

C 




REAL*8 CENTER, BLKSIZ.CLAT.CLON, DIPLAT 

DIMENSION TEMP(28 , 500) , ITEMP(28 , 500 ) ,RA(28) ,IA(28) ,OA(28) , 
g KTEMP( 500) .CENTER (500, 2) 

EQUIVALENCE (TEMP(l.l) .ITEMP(l.l) ) 

EQUIVALENCE (RA(1) ,IA(1) ) 

DATA BLKSIZ/10.0/ .ISEED/ 123456/ 

C 

C CALL ZONE AND MIDDLE TO FIND CENTER OF EACH 10X10 BIN. 

CALL ZONE(BLKSIZ) 

CALL MIDDLE (CENTER) 


00240000 

00250005 

00260000 

00270000 

00280000 

00290000 

00300000 

00310000 

00320000 

00330000 

00340000 


C INITIALIZE RANDOM NUMBER GENERATOR. 

CALL RANDU (ISEED , IY , YOUT ) 

C 

C COUNTER VARIABLES : 

C NBIN : BIN # 

C IBIN : # OF POINTS IN A BIN 

C IGOAL : # OF POINTS IN BIN AFTER WEEDING PROCESS 

C IBAD : / OF BAD POINTS PER BIN FROM PREVIOUS WEEDING. 

C IGOOD : # OF GOOD POINTS PER BIN. CHANGES W/ WEEDING. 

C IDST : # OF POINTS PER BIN REJECTED BECAUSE OF DST. 

C IRAN : RANDOM INTEGER BETWEEN 1 AND IGOOD 

C KZAP : NUMBER OF POINTS REJECTED IN RANDOM POINT 

C REJECTION OPTION. 

C ITEMP(18,I) : INOTE REJECTION FLAG. INOTE=0 MEANS GOOD DATA. 

C 


00350000 

00360000 

00370000 

00380000 

00390000 

00400000 

00410000 

00420000 

00430000 

00440000 

00450000 

00460000 

00470000 

00480005 

00481005 
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NBIN = 1 
IBIN = 0 


2 READ(10,END=6) RA 
IF(IA(1) .EQ. 0) GO TO 2 

3 IBLKNO = IA(16) 

IF(IBLKNO .NE. NBIN) GO TO 6 
IBIN = IBIN+1 

DO 4 J=l, 28 

4 TEMP (J, IBIN) = RA(J) 

GO TO 2 


6 IF (IBIN .EQ. 0) THEN 
WRITE (6, 600) NBIN 
NBIN = NBIN+1 
C FOR A BLKSIZE OF 10.0, 
IF (NBIN .GT. 426) GO 
GO TO 3 
ENDIF 


THE MAXIMUM / OF BINS EQUALS 426 
TO 44 


CLAT = CENTER ( NBIN, 1) 
CLON = CENTER(NBIN ,2) 


C 

C 


C 


CALCULATE DIPOLE LATITUDE OF CENTER OF 
CALL DIPOLE (CLAT, CLON, DIPLAT) 
WRITE(6, 611) NBIN, CLAT, CLON, DIPLAT 
611 FORMAT (/,8X. 13, * CLAT , CLON , DIPLAT : 
SET IGOAL ACCORDING TO DIP LATITUDE. 
IF( DABS ( DIPLAT ) -LE. 30.0 ) THEN 


BIN NBIN. 


’ , 3 (F7 . 2 , 2X) ) 


IGOAL = 3 


ELSE 

IGOAL = 9 


ENDIF 


C FIND IBAD, INITIAL IGOOD 
IBAD = 0 
IGOOD = 0 
DO 10 1=1, IBIN 

IF(ITEMP(18 , I) .EQ. 0) THEN 
IGOOD = IGOOD+1 
ELSE 

IBAD = IBAD + 1 
ENDIF 

10 CONTINUE 

IF( IGOOD .LE. IGOAL ) THEN 

WRITE (6,601) NBIN , IBIN , IGOOD , IBAD . IGOAL 

GO TO 33 
ENDIF 

c ALL BINS WHICH GET TO THIS STAGE STILL HAVE TOO MANY GOOD POINTS 

IDST = 0 
DO 15 1=1, IBIN 

IF ( ITEMP (18,1) .NE. 0) GO TO 15 


00490000 

00500000 

00510000 

00520000 

00520010 

00530000 

00540005 

00550000 

00560000 

00570005 

00580000 

00590000 

00600000 

00610000 

00620000 

00630000 

00640000 

00650000 

00660000 

00670000 

00680000 

00690000 

00700000 

00710000 

00720000 

00730000 

00740000 

00750000 

00760000 

00770000 

00780005 

00790000 

00800005 

00810000 

00820000 

00830000 

00840000 

00850000 

00860000 

00870005 

00880000 

00890000 

00900000 

00910000 

00920000 

00930000 

00940000 

00950000 

00960000 

00970000 

00980000 

00990000 

01000000 

01010000 

01020005 


A-91 


c (NEXT IF BLOCK IS FOR GOOD POINTS ONLY) 

IF (IGOOD .GT. IGOAL) THEN 

IF( ITEMP(17,I) .LT. -20 .OR. ITEMP(17,I) .GT. 5 ) THEN 
ITEMP(18.I) = 7 
IGOOD - IGOOD- 1 
IDST - IDST+1 
GO TO 15 
ENDIF 

ELSE 

WRITE (6,602) NBIN , IBIN , IGOOD , IBAD , IDST , IGOAL 
GO TO 33 
ENDIF 

15 CONTINUE 

C AT THIS POINT, BIN STILL HAS TOO MANY GOOD POINTS, EVEN AFTER IBAD, 
C DST REJECTIONS . 

C NOW RANDOMLY REJECT POINTS IN THE BIN UNTIL IGOAL HAS BEEN REACHED. 


K = 0 

DO 20 1=1, IBIN 

IF(ITEMP(18,I) .EQ. 0) THEN 
K = K+l 
KTEMP(K) = I 
ENDIF 

20 CONTINUE 
KZAP = 0 

21 IF (IGOOD .EQ. IGOAL) GO TO 25 

C GENERATE IRAN (BETWEEN 1 AND IGOOD) 
IX = IY 

CALL RANDU ( IX , IY , ZOUT ) 

IRAN = INT ( ZOUT+IGOOD ) 

IF (IRAN .EQ. 0) IRAN = 1 

KZAP = KZAP+1 

C ADJUST KTEMP ACCORDING TO IRAN. 

IF( IRAN .EQ. IGOOD ) THEN 
IGOOD = IGOOD- 1 
GO TO 21 
ELSE 

DO 23 K=IRAN, IGOOD- 1 
23 KTEMP (K) = KTEMP (K+l) 

IGOOD = IGOOD- 1 
GO TO 21 
ENDIF 

C FIRST SET ALL POINT FLAGS TO ' BAD’ . 
C GOOD . 

25 DO 27 1=1, IBIN 

27 ITEMP (18,1) = 7 
DO 28 1=1, IGOAL 

IQ = KTEMP ( I ) 

28 ITEMP (18, IQ) = 0 


01030000 
01040000 
01050005 
01060005 
01070000 
01080000 
01090000 
01100000 
01110000 
01120000 
01130000 
01140000 
01150000 
01160000 
01170000 
01180000 
01190000 
01200000 
01210000 
01220000 
01230000 
01240005 
01250000 
01260000 
01270000 
01280000 
01290000 
01300000 
01310000 
01320000 
01330000 
01340000 
01350000 
01360000 
01370000 
01380000 
01390000 
01400000 
01410000 
01420000 
01430000 
01440000 
01450000 
01460000 
01470000 
01480000 
01490000 
01500000 

THEN SET POINTS IN KTEMP TO 01501005 

01502005 

01510000 

01520005 

01530000 

01540000 

01550005 
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WRITE (6,603) NBIN , IBIN , IGOOD , IBAD , IDST , KZAP , IGOAL 

33 DO 35 1=1, IBIN 

DO 34 J=l,28 

34 OA(J) = TEMP ( J , I ) 

35 WRITE (11) OA 

NBIN = NBIN+1 

IF (NBIN .GT. 426) GO TO 44 
IBIN = 0 
GO TO 3 


44 STOP 


c ‘eoo Fora»T(/.2x”^*“******* bin number hbs : zero points-) 

601 F0FMAT(2X,*^^^§^ BIN # M3,’ ALREADY AT IGOAL. . 

e / iox ’# POINTS IN BIN: *,I3,/,10X, 

q GOOD POINTS IN BIN: 1 , 13 , / , IOX , * 4 BAD POINTS IN BIN: ,13, 

6 /,15X, ’IGOAL : ’,13) ^ Tic-rur ncT* 

602 F0RMAT(2X.-SSSS$S$SS BIN I MB.' REDUCED TO IGOAL USING DST . 

fi i y f VAT TIES 1 / IOX. * # POINTS IN BIN: .13, /.luX, 

\ * GOOD^POINTS IN BIN : ’ ,13, / ,10X, ’# BAD POINTS IN BIN: M3, 

fi / IOX ’/ DST REJECTS IN BIN: ’ , 13 ,/, 15X, * IGOAL : ,13) 

603 € FORMAT(2X,*Zmm22 BIN * M3,’ REDUCED TO IGOAL USING IRAN’, 
€ IX, ’OPTION.’, /.IOX,’# POINTS IN BIN: , T , 

q •/ GOOD POINTS IN BIN: ’,13,/, IOX,’# BAD POINTS IH BIN: ,13, 

q /, IOX,’# DST REJECTS IN BIN: ’,13 IOX, ’RANDOM REJECTS : ,13, 

q /,15X, ’IGOAL : ’.13) 

END 


SUBROUTINE DIPOLE (DLAT , DLON , DIPLAT ) 


r THIS ROUTINE CALCULATES THE DIPOLE LATITUDE OF A POSITION, GIVEN 
C ™S JTXloSc (DEGREES) . A GEOCENTRIC EARTH IS ASSUMED. 


c DRA CONVERST DEGREES TO RADIANS. THETAO IS E gL E S) 

C THE GEOMAGNETIC POLE, PHIO THE LONGITUDE OF THE POLE (IN DEGREES). 

IMPLICIT REAL *8 (A-H.O-Z) 

DATA DRA/ . 0174532925208D0/ .PHIO/289.2/ 


THETAO = 11 . 12*DRA 
TCOSO = DCOS( THETAO) 
TSINO = DSIN (THETAO) 


C 

C 


COMPUTE DIPLAT, ABSDIP 

COLAT = DRA* (90.0 -DLAT) 

DFLLON = DRA* (DLON -PHIO ) 

Q = ?COSO*DCOS (COLAT) + TSINO*DSIN(COLAT) *DCOS (DELLON) 
DIPLAT = 90.0 - (DACOS (Q) ) /DRA 


RETURN 

END 


01560000 

01570000 

01580000 

01590000 

01600005 

01610003 

01620000 

01630000 

01640000 

01650000 

01660000 

01670000 

01680000 

01690000 

01700000 

01710000 

01720000 

01730000 

01740000 

01750000 

01760000 

01770000 

01780000 

01790000 

01800000 

01810000 

01820000 

01830000 

01840000 

01850000 

01860000 

01870000 

01880000 

01890000 

01900000 

01910000 

01920000 

01930000 

01940000 

01950000 

01960000 

01970000 

01980000 

01990000 

02000000 

02010000 

02020000 

02030000 

02040000 

02050000 

02060000 

02070000 

02080000 

02090000 

02100000 
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SUBROUTINE ZONE(DELT) 

IMPLICIT REALMS (A-H.O-Z ) 

DIMENSION RLAT(180) V RSQ(180) , AREA (180) 

COMMON J f N(180) r M f T1 t PHITOP (180) , DLAM(180) , NROW(180) # PHIBAR(180) 


SPECIFY INITIAL DELT « DEL(ALAT) 
DEL (LAMBDA) =10 DEGREES 
DELT=10 .DO 

SPECIFY POINT (ALAT, ALONG) 
ALAT(-90 f +90) ALONG(0,360) 


DRCONV=3 . 14159265D0 / 180 .DO 


J = ( 90 .DO /DELT) 

NPOLBK = J * .25 
IF ( NPOLBK . GT . 3 ) NPOLBK- 3 
DELL = 0 

DO 10 K=1 1 J 

DELL = DELL + DELT 
10 PHITOP(K) = DELL 

LAST-4 

DO 100 ITER-1, LAST 
PHIBAR(l) * PHITOP(l) /2.D0 
RLAT(l) = PHITOP (1) 

DO 20 K-2, J 

RLAT(K) = PHITOP (K) - PHITOP(K-l) 

20 PHIBAR(K) = (PHITOP (K) + PHITOP (K-l) ) /2. DO 
DO 30 K=l, J 

30 N(K) = 360 , DO /DELT * DCOS (PHIBAR(K) *DRCONV)+. 5 

DO 50 K=l, NPOLBK 
KJ = J+l-K 

50 N(KJ) « 4* (2*K-1) 


DO 60 K=l f J 

DLAM(K)=360.D0/N(K) 

60 RSQ(K) -DLAM ( K ) *DCOS ( PH IBAR ( K ) +DRCONV ) / FLAT ( K ) 

C DO 90 K=1,J 

C 90 WRITE(6,120)K,N(K) , PHITOP (K) , PHIBAR(K) ,DLAM(K) ,RSQ(K) , AREA(K) 
C 120 FORMAT (IX, ’K=* ,13, 2X, *N=* ,I3,2X, ’PHITOP*’ .F5.2, 

C . 2X, f PHIBAR=* , F5.2,2X, *DLAM=’ ,F5.2,2X, ’RSQ-’ ,F5.3,2X, 

C . *AREA(SQKM)=’ , F9.1) 

IF ( ITER. EQ. LAST) GO TO 100 
DO 70 K=1 , J 

CALL NEVT0N(J ,K,N, PHITOP (K) ) 

70 CONTINUE 
100 CONTINUE 
M=0 


02110000 

02120000 

02130000 

02140000 

02150000 

02160000 

02170000 

02180000 

02190000 

02200000 

02210000 

02220000 

02230000 

02240000 

02250000 

02260000 

02270000 

02280000 

02290000 

02300000 

02310000 

02320000 

02330000 

02340000 

02350000 

02360000 

02370000 

02380000 

02390000 

02400000 

02410000 

02420000 

02430000 

02440000 

02450000 

02460000 

02470000 

02480000 

02490000 

02500000 

02510000 

02520000 

02530000 

02540000 

02550000 

02560000 

02570000 

02580000 

02590000 

02600000 

02610000 

02620000 

02630000 

02640000 

02650000 
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DO 110 KK=1.J 
110 M=M+N (KK) 

RETURN 

END 

C SUBROUTINE NEWTON 

SUBROUTINE NEWTON(J,K,N,ALAT) 
IMPLICIT REAL *8(A-H,0-Z) 
DIMENSION N(180) 

DRCONV=3 .14159265D0/180.D0 

C COMPUTE AREA FACTORS 

SUML=0. 00 
SUMLL=0 . 00 

DO 10 L=1 , K 
10 SUML=SUML+N ( L ) 

DO 20 LL>=1,J 
2 0 SUMLL=SUMLL+N ( LL ) 

FACTOR=SUML / SUMLL 
ALAT=ALAT *DRCONV 
PHIO=ALAT 


DO 100 L=1 , 5 

DERIV=DCOS (PHIO ) 
FP=(DSIN(PHIO) -FACTOR) /DERIV 
EPS=FP/PHIO 


IF(DABS(EPS) .LT.l.D-5)GO TO 200 
ALAT=PHIO-FP 
100 PHI0=ALAT 
200 CONTINUE 

ALAT=ALAT / DRCONV 
RETURN 
END 


SUBROUTINE MIDDLE (CENTER) 


02660000 

02670000 

02680000 

02690000 

02700000 

02710000 

02720000 

02730000 

02740000 

02750000 

02760000 

02770000 

02780000 

02790000 

02800000 

02810000 

02820000 

02830000 

02840000 

02850000 

02860000 

02870000 

02880000 

02890000 

02900000 

02910000 

02920000 

02930000 

02940000 

02950000 

02960000 

02970000 

02980000 

02990000 

03000000 

03010000 

03020000 

03030000 

03040000 

03050000 

03060000 

03070000 

03080000 

03090000 

03100000 


c= 

c 

c 

c 

c 

c 

c 

c 

c 


IS SUBROUTINE CALCULATES THE LATITUDE AND LONGITUDE OF THE 
NTER OF EACH BIN. THE COORDINATES ARE THEN STORED IN THE 

RAY * CENTER . ’ 


p F v ample CENTER (4 1) AND CENTER (4, 2) WOULD BE THE LATITUDE 
l LONGITUDE^RESPECTIVELY) of the center of the fourth bin. 


*C 03110000 
C 03120000 
C 03130000 
c 03140000 
C 03150000 
c 03160000 
C 03170000 
C 03180000 
=C 03190000 
03200000 
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IMPLICIT REAL *8 (A-H.O-Z) 

REAL** RLAT , RLON , CSIZE 
CHARACTER*1 BIN(5) 

COMMON J,N(180) ,M, T1,PHIT0P(180) ,DLAM(180) ,NROW(180) , PHIBAR(180) 
DIMENSION CENTER(500,2) ,NN(500) 

C NN NUMBERS THE BINS CONSECUTIVELY. 

C (N IS THE NUMBER OF BINS IN EACH ROW.) 

NN(1) = 0 
DO 6 I * 2, J+l 

6 NN(I) = NN(I-l) + N(I-l) 


CALCULATE CENTERS FOR NORTHERN HEMISPHERE 

DO 9 K = 2, J+l 

DO 8 I = NN(K-1)+1. NN(K) 

CENTER (1,1) - PHIBAR(K-l) 

IF(I.EQ.l) GO TO 7 

CENTER(I, 2) *= CENTER(I-1,2) + DLAM(K-l) 

7 CENTER (1,2) = DLAM(1)/2.D0 

8 IF(CENTER(I,2).GT.360.) CENTER(I, 2) * DLAM(K-l) /2.D0 

9 CONTINUE 


CALCULATE CENTERS FOR SOUTHERN HEMISPHERE 

DO 10 I ■ NN ( J+D+l, 2*NN( J+l) 

CENTER (1,1) - -CENTER(I-NN( J+l) ,1) 
CENTER(I t 2) = CENTER ( I -NN( J+l) ,2) 
10 CONTINUE 
RETURN 
END 


SUBROUTINE RANDU ( IX , I Y f YFL ) 


C 

c 

c 

C 

c 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


03210000 
03220000 
03230000 
03240000 
03250000 
03260000 
03270000 
03280000 
03290000 
03300000 
03310000 
03320000 
03330000 
03340000 
03350000 
03360000 
03370000 
03380000 
03390000 
03400000 
03410000 
03420000 
03430000 
03440000 
03450000 
03460000 
03470000 
03480000 
03490000 
03500000 
03510000 
03520000 
03530000 
03540000 
03550000 
03560000 
03570000 
. . 03580000 


SUBROUTINE RANDU 
PURPOSE 

COMPUTES UNIFORMLY DISTRIBUTED RANDOM REAL NUMBERS BETWEEN 
0 AND 1.0 AND RANDOM INTEGERS BETWEEN ZERO AND 
2**31 . EACH ENTRY USES AS INPUT AN INTEGER RANDOM NUMBER 
AND PRODUCES A NEW INTEGER AND REAL RANDOM NUMBER. 

USAGE 

CALL RANDU ( IX 1 1 Y , YFL ) 

DESCRIPTION OF PARAMETERS 

IX - FOR THE FIRST ENTRY THIS MUST CONTAIN ANY ODD INTEGER 
NUMBER WITH NINE OR LESS DIGITS. AFTER THE FIRST ENTRY 
IX SHOULD BE THE PREVIOUS VALUE OF IY COMPUTED BY THIS 
SUBROUTINE . 


03590000 
03600000 
03610000 
03620000 
03630000 
03640000 
03650000 
03660000 
03670000 
03680000 
03690000 
03700000 
03710000 
03720000 
, 03730000 
03740000 
03750000 
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IY - A RESULTANT INTEGER RANDOM NUMBER REQUIRED FOR THE NEXT03760000 
ENTRY TO THIS SUBROUTINE. THE RANGE OF THIS NUMBER IS 03770000 
BETWEEN ZERO AND 2**31 

YFL- THE RESULTANT UNIFORMLY DISTRIBUTED. FLOATING POINT, 03790000 
RANDOM NUMBER IN THE RANGE 0 TO 1.0 ^eJoOOO 

03820000 

SUBROUTINE IS SPECIFIC TO SYSTEM/360 AND BILL PRODUCE 03830000 
2**29 TERMS BEFORE REPEATING. THE REFERENCE BELOW DISCUSSES03840000 
SEEDS (65539 HERE). RUN PROBLEMS. AND PROBLEMS CONCERNING 03850000 
RANDOM DIGITS USING THIS GENERATION SCHEME. MACLAREN AND 03860000 
MARSAGLIA JACM 12, P. 83-89, DISCUSS CONGRUENTIAL 03870000 

GENERATION METHODS AND TESTS. THE USE OF TWO GENERATORS OF 03880000 
STtT« FILLING a TABLE AND one PICKING FROM THE0389000 
TABLE IS OF BENEFIT IN SOME CASES. 65549 HAS BEEN 03900000 

SUGGESTED AS A SEED WHICH HAS BETTER STATISTICAL PROPERTIES 03910000 
FOR HIGH ORDER BITS OF THE GENERATED DEVIATE. 03920000 

SEEDS SHOULD BE CHOSEN IN ACCORDANCE WITH THE DISCUSSION 03930000 
GIVEN IN ^E REFERENCE BELOW. ALSO, IT SHOULD BE NOTED THAT03940000 
TF FLOATING POINT RANDOM NUMBERS ARE DESIRED, AS ARE 

FROM RANDU. THE RANDOM CHARACTERISTICS OF THE 03960000 

FLOATING POINT DEVIATES ARE MODIFIED AND IN FACT THESE 03970000 

DEVIATES HAVE HIGH PROBABILITY OF HAVING A TRAILING LOW 03980000 

ORDER ZERO BIT IN THEIR FRACTIONAL PART. OAOOOOOO 

SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED 04020000 

N0NE 04030000 

04040000 

MET P0WER RESIDUE METHOD DISCUSSED IN IBM MANUAL C20-8011. 

RANDOM NUMBER GENERATION AND TESTING n . n , nnnfl 


IY=IX*65539 
IF(IY) 5,6,6 

5 IY=IY+2147483647+1 

6 YFL=IY 

YFL=YFL* . 4656613E-9 

RETURN 

END 

II EXEC LINKGO, REGION. GO=500K 

/ /GO.FTlOFOOl DD DSN=XRJRR.NOV2385 .DSTl.DISP-SHR 
I /G0.FT11F001 DD DSN=XRJRR.N0V2385 . SIFT .DATA, 

1 1 UNIT=SYSDA, SPACE- (TRK, (10,5) ,RLSE) , VOL-SER-SACC05 , 

/ / DISP=(NEW,CATLG) ,DCB=(RECFM=VBS,LRECL=116,BLKSIZE=11604) 


II EXEC NOTIFYTS 

11 9 0 0 0 01984.06371.2 0 
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COEFFICIENTS CAL84FID 


XRDSC.DMSP.CALBB.TEST4. TEST. DATA 
2 1-29878.1992 0.0000 26.9879 0.0000 0.0000 


2 

2 - 

1924.0500 

5526.5508 

3 

1 - 

2063.3401 

0.0000 

3 

2 

3044.3201 - 

2183.8701 

3 

3 

1682.8701 

-291.6460 

A 

1 

1279.3401 

0.0000 

A 

2 - 

2200.8101 

-317.4509 

A 

3 

1250.1299 

282.9050 

A 

A 

831.3350 

-289.1660 

5 

1 

943.0530 

0.0000 

5 

2 

776.3311 

230.8580 

5 

3 

370.7820 

-248.3420 

5 

A 

-424.3979 

64.1152 

5 

5 

174.5670 

-294.2991 

6 

1 

-211.9340 

0.0000 

6 

2 

358.8789 

45.6865 

6 

3 

252.2410 

145.8200 

6 

A 

-90.4987 

-152.3840 

6 

5 

-162.3880 

-77.5140 

6 

6 

-48.5517 

97.0991 

7 

1 

50.2750 

0.0000 

7 

2 

65.8066 

-14.4218 

7 

3 

48.4155 

88.5492 

7 

A 

-186.4770 

71.0999 

7 

5 

1.9858 

-47.6321 

7 

6 

15.7450 

-2.9277 

7 

7 

-103.6940 

20.6672 

8 

1 

75.1637 

0.0000 

8 

2 

-62.4921 

- 83.4985 

8 

3 

2.8062 

-24.7745 

8 

A 

23.7248 

- 4.3465 

8 

5 

-4.9795 

20.8105 

8 

6 

1.1965 

21.6843 

8 

7 

10.5049 

-23.1920 

8 

8 

-2.1680 

-5.2178 

9 

1 

20.3340 

0.0000 

9 

2 

5.2416 

6.0690 

9 

3 

1.0119 

-18.4504 

9 

A 

-9.5814 

6.2423 

9 

5 

-10.2597 

-23.2842 

9 

6 

3.3773 

6.9580 

9 

7 

3.8130 

14.4615 

9 

8 

4.6053 

-15.2854 

9 

9 

-2.7086 

-11.8510 

10 

1 

5.4469 

0.0000 

10 

2 

10.3427 

-20.8446 

10 

3 

1.5372 

15.3630 

10 

A 

-12.3475 

8.9692 

10 

5 

9.4-340 

-5.3201 

10 

6 

-3.4223 

-6.3449 

10 

7 

-1.1907 

8.9932 

• 10 

8 

6.6870 

9.6466 


7.9558 -19.3154 0.0000 


16.6929 

0.0000 

0.0000 

4.2478 

-13.6396 

0.0000 

5.0440 

-22.9796 

0.0000 

-0.5587 

0.0000 

0.0000 

-5.0723 

4.5528 

0.0000 

-0.1853 

3.0011 

0.0000 

-0.3731 

-9.2377 

0.0000 

1.3461 

0.0000 

0.0000 

-1.4823 

4.6653 

0.0000 

-6.7795 

2.0878 

0.0000 

-1.3651 

2.8099 

0.0000 

-6.0780 

0.7172 

0.0000 

1.4847 

0.0000 

0.0000 

0.4091 

-0.1262 

0.0000 

-2.2093 

-0.9964 

0.0000 

-4.0607 

-0.4410 

0.0000 

-0.1193 

0.0529 

0.0000 

-0.1276 

1.2475 

0.0000 

0.5828 

0.0000 

0.0000 

0.0736 

0.0835 

0.0000 

1.6242 

-1.1229 

0.0000 

1.4083 

0.1306 

0.0000 

-0.4003 

-1.1404 

0.0000 

0.4817 

-0.1775 

0.0000 

1.0083 

0.8616 

0.0000 

0.8018 

0.0000 

0.0000 

-0.8234 

-0.2392 

0.0000 

0.3449 

0.6610 

0.0000 

0.7469 

0.2003 

0.0000 

1.8643 

1.1319 

0.0000 

0.1407 

0.9747 

0.0000 

-0.0207 

-0.0463 

0.0000 

-0.1217 

1.1180 

0.0000 

0.4621 

0.0000 

0.0000 

-0.3242 

-0.1839 

0.0000 

0.3637 

-0.2367 

0.0000 

0.3523 

0.5092 

0.0000 

-0.8320 

-0.2703 

0.0000 

-0.2127 

-0.5421 

0.0000 

0.2749 

-0.4055 

0.0000 

-0.3537 

-0.5202 

0.0000 

-0.3326 

0.6775 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 


0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 


A-98 



10 

9 

1.5169 

-5.9544 

10 

10 

-5.0012 

1.9564 

11 

1 

-3.4339 

0.0000 

11 

2 

-3.9929 

1.2819 

11 

3 

2.2212 

0.4725 

11 

4 

-5.4240 

2.6617 

11 

5 

-1.9861 

5.7697 

11 

6 

4.5759 

-4.2347 

11 

7 

3.1589 

-0.4227 

11 

8 

0.9086 

-1.3564 

11 

9 

1.9800 

3.5678 

11 

10 

2.7993 

-0.4621 

11 

11 

-0.2744 

-6.1346 

0 

0 



0 

0 






0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0 . 0000 


0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 

0.0000 
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PROGRAM DSTADD 

//XRJRRDST JOB (F8002.X22, 20) .DSTADD, TIME=(2, 00) ,CLASS«O f NOTIFY=XRJRR, 

/ / MSGCLASS-X 
/♦JOBPARM LINES-30 

II* PROGRAM TO ADD DST VALUES TO DMSP DATA. ALSO ADDS BIN NUMBERS. 

II* XRJRR.DMSP. PROGRAMS (DSTADD) 

II EXEC FORTRAN, PARM=’XREF* 

II SYSIN DD * 

DIMENSION A (28, 100) ,IA(28,100) ,AA(28,5000) , IAA ( 28 , 5000 ) , 

€ IDST(24) ,IDEL(13) ,AOUT(28) 

EQUIVALENCE ( A . IA ) 

EQUIVALENCE ( AA , IAA ) 

C THIS PROGRAM READS IN DMSP DATA, IN "FIT" FORMAT, AS OUTPUT FROM 
C T.J. SABAKA’S DMSP PROCESSING PROGRAM. IT ADDS DST VALUES TO THE 
C DATA. AND ALSO ADDS BIN NUMBERS TO THE DATA. IT ALSO DELETES 
C SPECIFIED DATES AND HOURS FROM THE DATA, WHICH HAVE BEEN CHECKED TO 
C HAVE HIGH KP INDICES OR EXCEPTIONALLY LARGE DST INDICES. 

C FINALLY, THE PROGRAM SORTS THE DATA BY BIN NUMBER. 

C 

C ***NOTE: DATA IS INPUT IN A FORMAT WHICH HAS 100 DATA VALUES PER 
C LOGICAL RECORD. IT IS OUTPUT ONE VALUE PER LREC. 

C DATA WILL EVENTUALLY BE OUTPUT 100 POINTS PER RECORD, 

C WITH A LATER PROGRAM. 

C **NOTE#2 : THIS VERSION OF THE PROGRAM SORTS THE DATA WITH THE 
C ‘NEW’ METHOD, POSSIBLY INEFFICIENT. 

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 

C SET BLKSIZE. ALSO SET THE DAYS AND HOURS OF DATA TO DELETE. 

C FORMAT OF DAYS AND HOURS IS (IFIX( (IHR-1) /3 ) + 1)*1000 + DAY. 

C THIS COMBINES THE DAY AND THE HOUR 'TRIPLET* INTO ONE NUMBER, TO 
C BE COMPARED TO THE ACTUAL TIME. ALSO SET NUMBER OF HOURLY TRIPLETS 
C WHICH WILL BE DELETED (=NDEL) . 

DATA BLKSIZ/10.0/ 

DATA NDEL/1/ .IDEL/5329, 0000, 0000, 0000, 0000, 0000, 0000, 0000, 

q 0000 , 0000 , 0000 , 0000 , 0000 / 

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 


DRCONV = 3.14159265/180.0 
C READ INITIAL LINE OF DATA FROM DST TAPE. 

READ(9 , 101 ) IYR.IDAY.IDST 
101 FORMAT (2X, 12, 13, 2X, 2414) 

C READ LINE OF DATA FROM TAPE 10. 

C KCOUNT COUNTS FROM 1 TO THE ENTIRE DATA SET. 

C NWRITE COUNTS THE NUMBER OF RECORDS WRITTEN OUT. 

C I COUNTS FROM 1 TO 100 

C KP COUNTS THE NUMBER OF RECORDS DELETED BECAUSE OF KP INDEX. 

C CALL ZONE TO SET UP EQUAL AREA BLOCKS OF (BLKSIZ) SIZE. 

CALL ZONE (BLKSIZ) 

KCOUNT = 0 
NWRITE = 0 


A- 100 



KP = 0 

2 READ ( 10 , END=55 ) A 
KCOUNT = KCOUNT + 1 

C ACCEPT DATA ONLY WHICH DO NOT HAVE NEGATIVE DATA QUALITY FLAGS 
A IF(IA(18 , I) -NE. 0 ) THEN 
1 = 1+1 

IF( I .GT. 100 ) GO TO 2 
GO TO A 
ENDIF 

IF(IA(1 , I ) .EQ. 0) THEN 
I = 1+1 

IF( I -GT. 100 ) GO TO 2 
GO TO A 
ENDIF 


JYR = IFIX(A(5,I) ) 

JDAY = IA(1,I) 

STIME = FLOAT (IA(2, I) ) /3 . 60E6 

C DELETE Data" WHICh" HAVe' BAD KP OR DST INDICES (GIVEN IN DATA STMT) 
JTEST = ( (JHR-D/3 + 1 )*1000 + JDAY 
IF( NDEL .EQ. 0 ) GO TO 7 
DO 5 J=1,NDEL 

IF (JTEST .EQ. IDEL(J)) THEN 
I = 1+1 
KP = KP+1 

IF (I .GT. 100) GO TO 2 
GO TO A 
ENDIF 

5 CONTINUE 


C 


C 


TEST WHETHER JYR EQUALS IYR 

7 IF (JYR .EQ. IYR) THEN 

GO TO 9 

jto E mesn-t equal IYR, SO READ another line OF DST TAPE 

8 READ (9, 101) IYR, IDAY, IDST 
GO TO 7 


c 

c 


c 


9 CONTINUE 

NOW THAT JYR EQUALS IYR, TEST WHETHER 
10 IF (JDAY .EQ. IDAY) THEN 


JDAY EQUALS IDAY 


GO TO 1A 
ENDIF 

JDAY DOESN’T EQUAL IDAY, SO READ ANOTHER 
12 READ (9, 101) IYR, IDAY, IDST 


LINE OF DST TAPE. 


GO TO 10 


c NOW Si AND JDAY ARE CORRECT. PULL OFF THE CORRECT HOURLY DST 
JDST = IDST(JHR) 

NWRITE=NWRITE+1 

C NOW FIND THE CORRECT BIN NUMBER FOR THE DATA. 
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C CALL INDX TO DETERMINE BLOCK NUMBER 
DLAT «= A(6 , 1) 

DLON = A(7 , I ) 

CALL INDX (DLAT, DLON, IBLKNO) 

C WRITE (6, 607) IBLKNO,NWRITE,IA(l,I) ,IA(2,I) , DLAT, DLON 
C 607 FORMAT (3X, ***** , 2X,I5,2X,I5,2X,I3,2X,I9,5X,2(F8.1,1X) ) 

IA( 16, I) “IBLKNO 
IA(17,I)=JDST 
C 

C PUT INFORMATION INTO OUTPUT ARRAY. 

C PUT BIN # INTO SLOT 16, DST VALUE INTO SLOT 17. 

C DO THIS THE 'NEW* WAY, IN WHICH IT WILL BE PRE- SORTED BY BIN 
C NUMBER AS IT IS BEING PUT INTO THE ARRAY. 

IF(NWRITE .EQ. 1) THEN 
DO 17 JJ=1, 28 
17 AA(JJ,1) = A(JJ,I) 

I = 1+1 

IF ( I .GT. 100 ) GO TO 2 
GO TO 4 
ENDIF 

K « 1 

20 KBLKNO = IAA(16,K) 

IF(KBLKNO .LE. IBLKNO) THEN 
K = K+l 

IF (K .GT. NWRITE) GO TO 25 
GO TO 20 
ENDIF 

DO 22 J*NWRITE, K, -1 
DO 22 JJ=1, 28 
22 AA(JJ, J+l) = AA(JJ,J) 

DO 24 JJ=1 , 28 

24 AA(JJ,K) = A( JJ , I) 

GO TO 27 

25 DO 26 JJ“1, 28 

26 AA( JJ ,K)=A( JJ , I ) 

27 CONTINUE 
I = 1+1 

IF( I .GT. 100 ) GO TO 2 
GO TO 4 
C 

C IF THE PROGRAM REACHES THIS NEXT LINE, THEN ALL DATA POINTS HAVE BEEN 
C READ IN AND SORTED. NOW WRITE OUT THE DATA. 

55 WRITE ( 6 , 605 ) NWRITE .KCOUNT.KP 

DO 58 J=l, NWRITE 
DO 57 JJ=1 , 28 

57 AOUT(JJ) = AA(JJ, J) 

58 WRITE (11) AOUT 

C ******* FORMATS ******** C 
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o o 


fiOS FORMAT (III 5X. ’TOTAL RECORDS WRITTEN OUT: * .I5./.5X, 

€ KCO^T - M6./.5X. ‘NUMBER OF KP DELETIONS: M5) 

606 FORMAT(2X,I5,2X,I5,5X,2(I3,2X) ) 


STOP 

END 


SUBROUTINE ZONE(DELT) 

SSSS-T-oJ ! PHIBAR( 180 ) , PHITOP ( 180 ) , DLAM(180 ) ,RLAT ( 180 ) , 

*RSQ(180) , AREA(180) 

COMMON /ZONE1/ J,N f M, PHITOP, DLAM 
DRCONV=3 . 1A159265D0 / 180 .DO 


J=(90.D0/DELT) 

NPOLBK=J*0 . 25 

IF ( NPOLBK . GT . 3 ) NPOLBK=3 

DELL=0 


DO 10 K=1 , J 
DELL=DELL+DELT 
10 PHITOP (K)=DELL 
LAST=A 

DO 100 ITER=1,LAST 
PHIBAR ( 1 ) =PHITOP ( 1 ) / 2 . DO 
RLAT ( 1 ) =PHIT0P ( 1 ) 

DO 20 K=2,J 

RLAT(K)=PHITOP(K) -PHITOP (K-l) 

20 PHIBAR (K) = ( PHITOP (K)+PHITOP (K-l) ) / 2. DO 

DO 30 K=1,J „ _ 

30 N(K)=360 .DO / DELT*DCOS ( PHIBAR ( K) *DRCONV ) +0 . 5 

DO 50 K=l, NPOLBK 


KJ=J+1-K 


50 N(KJ)=A*(2*K-1) 

DO 60 K=l, J 

DLAM (K) =3 60 .DO /N (K) 

60 RSQ(K) =DLAM ( K ) *DCO S ( PHIBAR ( K ) *DRCONV ) / RLAT ( K) 
IF ( ITER. EQ. LAST) GO TO 100 


DO 70 K=1,J 

CALL NEWTON (J.K.N, PHITOP ( K) ) 


70 CONTINUE 
100 CONTINUE 


M=0 

DO 110 KK=1,J 
110 M=M+N(KK) 

RETURN 

END 

SUBROUTINE NEWTON (J.K.N, ALAT ) 
IMPLICIT REAL *8 (A-H.O-Z) 
DIMENSION N ( 180) 

DRCONV=3 . 1A159265D0 / 180 . DO 
SUML=0 . 00 
SUMLL=0 . 00 
DO 10 L=1,K 
10 SUML=SUML+N (L) 

DO 20 LL=1 , J 
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20 SUMLL=SUMLL+N(LL) 

FACTOR=SUML / SUMLL 
ALAT«=ALAT*DRCONV 
PHIO-ALAT 
DO 100 L-1,5 
DERIV-DCOS(PHIO) 

FP—(DSIN(PHIO) -FACTOR) / DERIV 
EPS-FP/PHIO 

IF (DABS (EPS) .LT.1.0D-5)GO TO 200 
ALAT-PHIO-FP 
100 PHIO-ALAT 
200 CONTINUE 

ALAT-ALAT / DRCONV 

RETURN 

END 

SUBROUTINE INDX ( ALAT , ALONG , IBLKNO ) 

IMPLICIT REAL *8(A-H,0-Z) 

DIMENSION N(180) ,PHITOP(180) ,DLAM(180) 
COMMON /Z0NE1/ J,N,M,PHITOP,DLAM 
IF (ALONG .LT. 0.D0) ALONG = ALONG + 360. DO 
APHI-DABS (ALAT ) 

DO 10 IS-l.J 
I=IS 

IF(PHITOP(IS) .GE.APHI) GO TO 300 
10 CONTINUE 
300 NTOT-O 

L=(ALONG/DLAM(I) )+l 
IF(I.EQ.l) GO TO 30 
DO 20 JJ=2 , I 
NTOT=NTOT+N ( J J- 1 ) 

20 CONTINUE 
30 CONTINUE 

IBLKN 0=NT0T+L 

IF(ALAT.LT.O) IBLKNO=IBLKNO+M 

RETURN 

END 


C 

II EXEC LINKGO , REGION . GO-3000K 
II G0.FT09F001 DD DSN-XRJRR . DST8 1 , DI SP-SHR 
//GO.FTlOFOOl DD DSN-XRSHS . NOV2385 . STEP5 . OUTBIN , DISP-SHR 
/ / * WRITE OUT TO TAPE 11 

/ /GO.FTllFOOl DD DSN-XRJRR • NOV2385 . DST1 , UNIT-SYSDA, 

/ / DCB= (RECFM— VBS , LRECL—116 , BLKSIZE— 11604 ) ,SPACE-(TRK, (10,5) ,RLSE) , 
II VOL=SER=SACC03 , DISP= (NEW, CATLG) 

/ / EXEC NOTIFYTS 
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PROGRAM EUTRANS 

/ /XRJRREUT JOB (F8002,X22, 25) , EUTRANS , TIME= ( 5 , 0 ) , CLASS=E,NOTIFY=XRJRR, 

{!. data in fit format. SPACECRAFT COORDINATES (UNIT 10) 

II* INPUT# 2: 3 EULAR ANGLES, 3 BIASES (DATA STATEMENT). 

II* OUTPUT : DMSP DATA TRANSFORMED AND CORRECTED (UNI ) • 

/♦JOBPARM LINES=10 

II EXEC FORTRAN , PARM= ’ XREF * 

II SYSIN DD * 

DIMENSION A (28, 100) 

DIMENSION AA(28) 

REAL*8 EU1 , EU2 , EU3 , DRCONV , SL1 , SL2 , SL3 
<:ft ftti FR ANGLES BIASES , SLOPES FOR CORRECTIONS . 

ECU? f0U?751D0i.EU 2 /-0.O0 2 S910-,2D0/.EUS/-0.OOS 2 7 3 A508D0/ 

DATA BS1/4 797/ ,BS2/-. 5051/ ,BS3/0. 6497/ 

IflA SL1 / 0 : 99993646D0 / , SL2/ 0 . 99960327D0 / , SL3 /I -0011901D0/ 

DRCONV = 3.14159265/180.0 

CALL ROUTINE TO CALCULATE TSM (EULER TRANSFORMATION) MATRIX FROM 
INPUT^EULER ANGLES EU1.EU2.EU3. THE OUTPUT ELEMENTS OF THIS 
MATRIX ARE STORED IN COMMON FOR USE IN SUBROUTINE APPL . 


C 

c 


c 

c 

c 

c 

c 

c 

c 


c 

c 


CALL EULER (EU1 , EU2 , EU3 ) 

READ data FROM UNIT# 10. 

1 READ (10 , END=22) A 
1=1 

PULL OFF A VALUE FROM A, PUT INTO AA FOR PROCESSING. 

2 DO A J=l,28 

A AA( J) = A ( J * I ) 

C VRITE(6 , 611) AA(ll) ,AA(12) ,AA(13) 

C 611 FORMAT (2X, ’BEFORE APPLY: * f 3 (F15.5, 2X) ) 

IF( AA(ll) .EQ. 0.0 ) GO TO 6 

C APPLY SLOPES, BIASES AND EULER ANGLE CORRECTIONS TO AA. 
CALL APPLY (AA, BS1, BS2, BS3 , SL1, SL2, SL3 ) 


C WRITE (6 , 612) AA(ll) ,AA(12) ,AA(13) 

C 612 FORMAT (2X, ’AFTER APPLY: * , 3 (F15 .5 , 2X) , / ) 

C PUT AA BACK INTO A 
6 DO 8 J=ll , 13 
8 A(J,I) = AA(J) 

C WRITE OUT A IF NECESSARY. 

IF (I .EQ. 100) THEN 
WRITE (11) A 
NWRITE=NWRITE+1 
GO TO 1 
ENDIF 
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C INCREMENT I, GO TO 2 
I = 1+1 
GO TO 2 
C 

22 WRITE (6, 601) NWRITE 

601 FORMAT (//,5X, 'A TOTAL OF ’,14,’ RECORDS READ IN. WRITTEN OUT’) 
STOP 
END 

MATM 1 
C 

SUBROUTINE APPLY (A, BSX , BSY.BSZ, SLX , SLY , SLZ ) 

C 

C THIS ROUTINE APPLIES THE EULER ROTATION MATRIX CALCULATED IN 
C ROUTINE 'EULER* TO DATA IN ARRAY A. FOR THIS VERSION OF APPLY. 

C A IS ASSUMED TO ALREADY BE IN SPACECRAFT COORDINATES. 

C A IS CORRECTED WITH BIASES AND SLOPES, THEN 
C CORRECTED FOR EULAR ANGLES BY TRANSFORMING WITH 
C ROTATION MATRIX TSM (IN COMMON BLOCK). 

C 

C INPUT: A, X, Y, AND Z BIASES, X,Y,Z SLOPES, TSM MATRIX. 

C OUTPUT: A (CORRECTED) 

C 

REAL *8 TSM11 , TSM12 , TSM13 , TSM21 , TSM22 . TSM23 . TSM31, TSM32 . TSM33 , 
e SLX, SLY, SLZ 

DIMENSION A (28) 

COMMON /TSM/ TSM11 , TSM12 , TSM13 , TSM21 , TSM22 , TSM23 , TSM31 , TSM32 , 
(1 TSM33 

C 

BIX = A(ll) 

B1Y = A(12) 

BIZ = A(13) 

C 

C APPLY SLOPES AND BIASES. 

B2X = (1.0/ SLX) * ( BIX - BSX ) 

B2Y = (1.0/SLY)*( B1Y - BSY ) 

B2Z = (1.0/SLZ)*( BIZ - BSZ ) 

C 

C APPLY EULER ANGLE ROTATIONS TO B2X,B2Y,B2Z TO GET CORRECTED A. 
A(ll) = TSM11*B2X + TSM12*B2Y + TSM13*B2Z 
A(12) = TSM21*B2X + TSM22*B2Y + TSM23*B2Z 
A(13) = TSM31*B2X + TSM32*B2Y + TSM33*B2Z 

C 

C 

RETURN 

END 

C 

c 

SUBROUTINE EULER ( EU1 , EU2 , EU3 ) 

C 

C THIS ROUTINE CALCUALATES THE NINE ELEMENTS OF TRANSFORMATION 
C MATRIX TSM, GIVEN EULER ANGLES EU1.EU2.EU3. OUTPUT IS STORED 
C IN COMMON . 

REAL*8 EU1, EU2 , EU3 , TCOS1 , TCOS2 , TCOS3 , TSIN1 , TSIN2, TSIN3 , 

£ TSM11 , TSM12 , TSM13 , TSM21 , TSM22 , TSM23 , TSM31 , TSM32, TSM33 
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REAL*8 PI.DRA 


COMMON /TSM/ TSM11 , TSM12 , TSM13 , TSM21 , TSM22 , TSM23 , TSM31 , TSM32 , 
% TSM33 
C 

DATA PI/ 3. 14159265/ 

DRA = PI/ 180.0 


CONVERT DEGREES TO RADIANS. 

EU1 = EU1*DRA 
EU2 = EU2*DRA 
EU3 = EU3*DRA 
TCOS1 = DCOS(EUl) 

TCOS2 = DCOS (EU2) 

TCOS3 = DCOS (EU3 ) 

TSIN1 = DSIN(EUl) 

TSIN2 = DSIN(EU2) 

TSIN3 = DSIN (EU3 ) 

TSM11 = TCOSl*TCOS3 

TSM12 = TCOSl*TSIN3*TCOS2 + TSIN1*TSIN2 

TSM13 = (-1.0) *TC0S1*TSIN3*TSIN2 + TSIN1*TC0S2 

TSM21 = (~1.0)*TSIN3 

TSM22 = TCOS3*TCOS2 

TSM23 = (-1.0) *TCOS3*TSIN2 

TSM31 = (-1.0)*TSIN1*TCOS3 

TSM32 = (-1 . 0)*TSIN1*TSIN3*TCOS2 + TC0S1*TSIN2 
TSM33 = TSIN1*TSIN2*TSIN3 + TCOSl*TCOS2 

RETURN 

END 


II EXEC LINKGO, REGION. GO=500K 

If go FT10F001 DD DSN=XRJRR.DMSP.FITPRP,DISP=SHR 

/ /GO.FTllF001^DD^DSN*XRJRR.GAItP,UHIT*SySDA,DISP“(HEW.CATLG) , 

/ /^^DCB=(RECFM=VBS ,LRECL=11204.ELKSI2E“22412) , SPACE“<TRK. (20,20) ,RLSE) , 
00006100 

/ / VOL=SER=S ACC 0 7 


/ / EXEC NOTIFYTS 
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PROGRAM FITPREP 


/ /XRJRRPRP JOB (F8002, X22, 30) , FITPRP,TIME=(0,30) , CLASS~0 # NOTIFY*XRJRR, 

/ / MSGCLASS=X 

/*JOBPARM LINES-10 

II EXEC FORTRAN ,PARM= f XREF’ 

/ /SYSIN DD * 

DIMENSION A(28) f IA(28) 

DIMENSION AA(28 , 100) 

EQUIVALENCE ( A , IA ) 

C THIS PROGRAM READS IN DMSP DATA, WHICH HAS BEEN FLAGGED 
C AND SIFTED BY PROGRAMS DSTADD AND BINSIFT. FOURTEEN DATA SETS 
C ARE READ IN. THESE ARE MERGED INTO ONE DATA 

C SET WHICH HAS GOOD POINTS ONLY AND WHICH CONTAINS 100 DATA POINTS 
C PER LOGICAL RECORD. THE FINAL LOGICAL RECORD IS PADDED OUT TO 100 
C BY ADDING ZEROS. 

C 

C INPUT DATA IS ON UNITS #11 - 24, AND OUTPUT ON UNIT #26. 

C 

c 

1 = 1 

NWRITE = 0 

1 ITOT = 0 
IGOOD = 0 
K = 10+1 

2 READ(K,END=18) A 
ITOT = ITOT+1 

C INOTE = IA(18). AN INOTE .NE. ZERO IS A BAD POINT. 

IF( IA( 18 ) .NE. 0 ) GO TO 2 
IGOOD = IGOOD+1 
I TEMP = I TEMP +1 

C TRANSFER INFORMATION FROM A TO AA (100 POINTS PER LRECL) . 

DO 4 J=1 , 28 
4 AA( J, ITEMP) = A(J) 


IF ( ITEMP .EQ. 100 ) THEN 
ITEMP = 0 
WRITE (26) AA 
NWRITE = NWRITE+1 
GO TO 2 
ELSE 

GO TO 2 
ENDIF 

18 WRITE (6, 601) I , ITOT , IGOOD, NWRITE 
IF ( I.NE. 14 ) THEN 
I = 1+1 
GO TO 1 
ELSE 

GO TO 22 
ENDIF 


00000010 
00000020 
00000030 
00000040 
00000050 
00000060 
00000070 
00000080 
C 00000090 
00000100 
00000110 
00000120 
00000130 
00000140 
00000150 
00000160 
00000170 
00000180 
■C 00000190 
00000200 
00000210 
00000220 
00000230 
00000240 
00000250 
00000260 
00000270 
00000280 
00000290 
00000300 
00000310 
00000320 
00000330 
00000340 
00000350 
00000360 
00000370 
00000380 
00000390 
00000400 
00000410 
00000420 
00000430 
00000440 
00000450 
00000460 
00000470 
00000480 
00000490 
00000500 
00000510 
00000520 
00000530 
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c 

c 

c 


00000540 

IF THE PROGRAM REACHES THIS NEXT LIRE. THEN ALL DATA POIHTS HAVE 
« mini tiAOT UTTFM TJPTTTRN OUT. FILL AA OUT TO. 100 UUUUUJOU 


k2d‘£ been written out. fill aa out to . 100 

WITH ZEROS IF NECESSARY AND WRITE OUT AA THE LAST TIME. 

22 IF(ITEMP .LE. 10) THEN 
GO TO 25 
ELSE 

DO 24 J=ITEMP+1 , 100 
DO 24 1=1,28 

24 AA(I, J)=0 
WRITE (26) AA 
NWRITE = NWRITE+1 
WRITE (6, 605) 

GO TO 25 
ENDIF 
C 

25 WRITE (6, 606) NWRITE 

c ******* FORMATS ******** C „ 

601 FORMAT ( / , 5X , * ZONE i ’,12, / ,5X, ’TOTAL POINTS: * 15 ’ 5 *’ 

fl » § GOOD POINTS- ’ 15, 9X,’# RECORDS WRITTEN OUT: ,14) 

6 05* FORMAT (/,2X, ’*♦***’ LAST RECORD HAS SOME ZEROED POINTS *♦***’) 

606 FORMAT(///.5X, ’TOTAL RECORDS WRITTEN OUT: ’,15) 

C 

STOP 

END 

It EXEC LINKGO , REGION . GO=1000K 

II GO.FTllFOOl DD DSN=XRJRR. JAN784 . SIFT .DATA, DISP=SHR 
/ /G0.FT12F001 DD DSN=XRJRR. JAN1784 .SIFT. DATA, DISP=SHR 
//GOFT13F001 DD DSN=XRJRR.MAR1984 . SIFT .DATA, DISP=SHR 
/ /GO.FT14F001 DD DSN=XRJRR. JUN2084 .SIFT. DATA, DISP=SHR 
/ /GO.FT15F001 DD DSN=XRJRR- AUG2084 .SIFT. DATA, DISP=SHR 
//G0.FT16F001 DD DSN=XRJRR. SEP1684 . SIFT .DATA, DISP=SHR 
//GO FT17F001 DD DSN=XRJRR. JAN1885 . SIFT .DATA, DISP=SHR 
//GOFT18F001 DD DSN=XRJRR.MAY2385 . SIFT .DATA, DISP=SHR 
//GO FT19F001 DD DSN=XRJRR. JUN1385. SIFT. DATA, DISP=SHR 
JiGolFTZOFOOl DD DSN=XRJRR. JUN1685 . SIFT . DATA, DISP=SHR 
//GO FT21F001 DD DSN=XRJRR* AUG0585 . SIFT *DATA,DIS *= 

//GO FT22F001 DD DSN=XRJRR.SEP2985. SIFT. DATA, DISP=SHR 
/ / GO . FT23F001 DD DSN=XRJRR. 0CT2685 . SIFT .DATA, DISP-SHR 
it go FT24F001 DD DSN=XRJRR.NOV2385 . SIFT .DATA, DIS “ 

GO FT26F001 DD DSN=XRJRR.DMSP.FITPRP.UNIT=SYSDA,DISP=SHR 
{ }*DCB=(RECFM=VBS,LRECL=11204,BLKSIZE=22412) ,SPACE=(TRK. (80,20) ,RLSE) 
/ /*VOL=SER=SACC09 
II EXEC NOTIFYTS 


00000560 

00000570 

00000580 

00000590 

00000600 

00000610 

00000620 

00000630 

00000640 

00000650 

00000660 

00000670 

00000680 

00000690 

00000700 

00000710 

00000720 

00000730 

00000740 

00000750 

00000760 

00000770 

00000780 

00000790 

00000800 

00000810 

00000820 

00000850 

00000860 

00000870 

00000881 

00000882 

00000883 

00000884 

00000885 

00000886 

00000887 

00000888 

00000889 

00000890 

00000900 

0000091 
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PROGRAM XYZ TRANS 


I /XRJRRTRA JOB (F8002.X22, 30) , XYTRANS , TIME- ( 2 , 0 ) ,CLASS=E,NOTIFY=XRJRR, 
/ / MSGCLASS-X 

//* INPUT: DMSP DATA IN FIT FORMAT, SPACECRAFT COORDINATES (UNIT 10) 
II* OUTPUT: DMSP DATA TRANSFORMED TO GEOCENTRIC COORDINATES (11). 
/*J0BPARM LINES-10 
II EXEC FORTRAN , PARM= ' XREF ’ 

II SYSIN DD * 

DIMENSION A (28, 100) 

DIMENSION AA(28) ,IA(28) 

EQUIVALENCE (AA.IA) 

REAL *8 DLAT , DLON , DRA, RH ( 3 ) , VH (3 ) , ANORM(3 ) ,EFX, EFY.EFZ 
C 

DRA = 3.14159265/180.0 
I COUNT = 0 
IGOOD = 0 
NWRITE=0 

C READ DATA FROM UNIT# 10. 

1 READ ( 10 , END=22 ) A 
1=1 

C 

C PULL OFF A VALUE FROM A, PUT INTO AA FOR PROCESSING. 

2 DO 4 J=l,28 

4 AA(J) = A( J , I ) 

ICOUNT = ICOUNT+1 

C IDIR IS THE SATELLITE DIRECTION (=+ OR -1) 

IDIR = IA(20) 

C DATA QUALITY TEST 

IF( IDIR.EQ. 0 .OR. IA(18).NE.O .OR. IA(l).EQ.O ) THEN 
GO TO 6 
ENDIF 

IGOOD = IGOOD + 1 

DLAT = AA(6) 

DLON = AA(7) 

IF (DLON .GT. 180.0) DLON = DLON-360.0 

C CALL TRANSF WITH IDIR.LAT AND LON INFORMATION. TO GET OUT 
C RH, VH AND ANORM COMPONENTS. USE THESE TO CALCULATE THE TGS 
C MATRIX, WHICH TRANSFORMS SPACECRAFT COORDINATES TO EARTH-FIXED. 
CALL TRANSF (DLAT, DLON, RH, ANORM, VH, IDIR) 

C XI.YI.ZI ARE SPACECRAFT COORDINATES. 

XI = AA(ll) 

YI = AA(12) 

ZI = AA(13 ) 

C TRANSFORM COORDINATES FROM SPACECRAFT TO EARTH-FIXED. 

EFX = -ANORM ( 1 ) *XI - RH(1)*YI + VH(1)*ZI 
EFY = -ANORM (2 ) *XI - RH(2)*YI + VH(2)*ZI 
EFZ = -ANORM (3 ) *XI - RH(3)*YI + VH(3)*ZI 
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C TRANSFORM EARTH -FIXED COORDINATES BACK TO GEOCENTRIC X.Y.Z. 
C PUT X INTO AA(ll), Y INTO AA(12), Z INTO AA(13). 


C 


DLAT ■= 
DLON = 
AA(ll) 


€ 


AA(1Z) 

AA(13) 


DLAT*DRA 

= L -DSIN^DLAT) *DCOS (DLON) *EFX - DSIN (DLAT) *DSIN( DLON) *EFY 
+ DCOS (DLAT) *EFZ 

- -DSIN (DLON) *EFX + DCOS (DLON) *EFY 

= -DCOS (DLAT) *DCOS (DLON) *EFX - DCOS (DLAT) *DSIN ( DLON )*EFY 


% - DSIN ( DLAT )*EFZ 

RE-ASSIGN FLAGS 
ITEMP = IA(22) 


IA(22) = IA(2A) 
IA(2A) = IA(23 ) 
IA(23) = TEMP 


C PUT AA INTO A 
6 DO 8 J=1 , 28 
8 A( J , I ) = AA(J) 

C WRITE OUT A IF NECESSARY. 
IF (I .EQ. 100) THEN 
WRITE (11) A 
NWRITE=NWRITE+1 
ENDIF 


C INCREMENT I, GO TO 2 
I = 1+1 

IF (I .GT. 100) GO TO 1 
GO TO 2 


22 

601 

602 


WRITE (6, 601) NWRITE 
FORMAT (//.5X, ’A TOTAL OF 
WRITE(6 , 602) ICOUNT.IGOOD 
FORMAT (//,5X. ’TOTAL POINTS INPUT: ’.15,* 


,IA,’ RECORDS WRITTEN OUT’) 


WITH* ,15, ' GOOD POINTS’) 


C 

C 

c 

c 

c 

c 


25 STOP 
END 

SUBROUTINE TRANSF (PHIR, ALAMR.RH, ANORM, VH , IDIR) 

RH=3 COMPS OF POSITION OF SATELLITE IN (X.Y.Z) COORDS 
ANORM=3 COMPS OF ORBIT NORMAL IN (X.Y.Z) COORDS 
VH=RH CROSS ANORM, VELOCITY UNIT VECTOR 
PHIR, PHIN=GEOCENTRIC LAT OF POSITION , NORMAL 
ALAMR ALAMN=LONG OF POSITION, NORMAL 

IDIR=+1,0,-1 SATELLITE ASCENDING , TURNING AROUND . DESCENDING 

IMPLICIT REAL*8 (A-H , O-Z ) 

DIMENSION RH ( 3 ) , ANORM ( 3 ) , VH ( 3 ) 

DATA PI / 3 . 1A159265AD0 / 

PHI ^S COMPUTED BY KNOWING THE ORBIT ' INCLINATION, 1=98.26 FOR 
DATA PHIN/ -8 . 7 ADO / 

CHECK THAT IDIR IS NOT ZERO. 

IF (IDIR .EQ. 0) WRITE (6,601) 
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60.1 FORMAT ( / , 3X, ’ ******* IDIR = ZERO. STOP EXECUTION.’) 

IF(IDIR .EQ. 0) STOP 
DO 1 1=1,3 
RH ( I ) =0 . DO 
ANORM ( I ) =0 . DO 
VH(I)=O.DO 
1 CONTINUE 

IF(IDIR.EQ.O) WRITE(6, 100) PHIR.ALAMR 
100 FORMAT (1H0, ’CANNOT FIND NORMAL FOR TURNING POINT AT’,2F10.2) 
IF(IDIR.EQ.O) RETURN 

ANGLE=DARCOS ( -DTAN (PHIR*DTR) *DTAN ( PHIN*DTR) ) / DTR 
IF(IDIR.EQ. 1) ALAMN=ALAMR-ANGLE 
IF(IDIR.EQ.-l) ALAMN-ALAMR+ANGLE 
RH ( 1)=DC0S (PHIR*DTR) *DCOS (ALAMR*DTR) 

RH ( 2 ) =DCOS ( PHIR*DTR) *DSIN (ALAMR*DTR) 

RH ( 3 ) =DSIN ( PHIR*DTR) 

ANORM ( 1 )=DCOS (PHIN*DTR) *DCOS (ALAMN*DTR) 

ANORM ( 2 ) =DCOS ( PHIN*DTR) *DSIN (ALAMN*DTR) 

AN0RM(3 )=DSIN(PHIN*DTR) 

VH ( 1 ) =- RH ( 2 ) *ANORM ( 3 ) +AN0RM ( 2 ) *RH ( 3 ) 

VH ( 2 ) =-RH ( 3 ) * ANORM ( 1 ) + ANORM ( 3 ) *RH ( 1 ) 

VH ( 3 ) =-RH ( 1 ) * ANORM ( 2 ) +ANORM( 1 ) *RH ( 2 ) 

RETURN 

END 

II EXEC LINKGO, REGION. GO=500K 
/ /GO.FTlOFOOl DD DSN=XRJRR.GARP,DISP=SHR 
II* TAPE 11 IS OUTPUT 

/ /GO.FTllFOOl DD DSN=XRJRR.DMSP .FITXYZ ,UNIT=SYSDA t DISP=SHR 

II* DCB= (RECFM=VBS , LRECL=11204 , BLKSIZE=22412 ) , SPACE= (TRK, (20,20) ,RLSE) , 

II* VOL=SER=SACC03 

II EXEC NOTIFYTS 


00006000 

00006100 

00006200 
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